Commit 6b9be734 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Remove SAVED_SERVICE

SITE_SERVICES.cont is now an Eliom reference that can be directly used
wherever a continuation is expected.
parent 17ee34a3
......@@ -136,7 +136,7 @@ module Make (N : CONFIG) = struct
end
module Register (C : CONT_SERVICE) (T : TEMPLATES) : EMPTY = struct
module Register (S : SITE_SERVICES) (T : TEMPLATES) : EMPTY = struct
let () = login_choose := T.login_choose
......@@ -169,17 +169,15 @@ module Make (N : CONFIG) = struct
let () = Eliom_registration.Any.register
~service:Services.login
(fun service () ->
let cont () () =
C.cont () >>= Eliom_registration.Redirection.send
in login_handler service cont
lwt cont = Eliom_reference.get S.cont in
login_handler service cont
)
let () = Eliom_registration.Any.register
~service:Services.logout
(fun () () ->
let cont () () =
C.cont () >>= Eliom_registration.Redirection.send
in Services.do_logout cont ()
lwt cont = Eliom_reference.get S.cont in
Services.do_logout cont ()
)
end
......
......@@ -41,5 +41,5 @@ end
module Make (C : CONFIG) : sig
module Services : AUTH_SERVICES
module Register (S : CONT_SERVICE) (T : TEMPLATES) : EMPTY
module Register (S : SITE_SERVICES) (T : TEMPLATES) : EMPTY
end
......@@ -310,9 +310,8 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = Html5.register ~service:W.S.home
(if_eligible can_read
(fun user () ->
let module X = struct let s = W.S.home end in
let x = (module X : SAVED_SERVICE) in
Eliom_reference.set S.saved_service x >>
let cont () () = Redirection.send W.S.home in
Eliom_reference.set S.cont cont >>
match_lwt Eliom_reference.get cast_confirmed with
| Some result ->
Eliom_reference.unset cast_confirmed >>
......@@ -383,11 +382,11 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = Any.register
~service:W.S.election_dir
(fun f () ->
let module X = struct
let s = Eliom_service.preapply W.S.election_dir f
end in
let x = (module X : SAVED_SERVICE) in
Eliom_reference.set S.saved_service x >>
let cont () () =
Eliom_service.preapply W.S.election_dir f |>
Redirection.send
in
Eliom_reference.set S.cont cont >>
handle_pseudo_file () f
)
......@@ -428,9 +427,8 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
(if_eligible can_read
(fun user () ->
Eliom_reference.unset ballot >>
let module X = struct let s = W.S.election_vote end in
let x = (module X : SAVED_SERVICE) in
Eliom_reference.set S.saved_service x >>
let cont () () = Redirection.send W.S.election_vote in
Eliom_reference.set S.cont cont >>
return W.S.booth
)
)
......@@ -483,16 +481,15 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
(if_eligible 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
let x = (module X : SAVED_SERVICE) in
Eliom_reference.set S.saved_service x >>
let cont () () = Redirection.send W.S.election_cast in
Eliom_reference.set S.cont cont >>
match_lwt Eliom_reference.get ballot with
| Some _ -> ballot_received uuid user
| None -> T.cast_raw ()
)
)
let () = Redirection.register
let () = Any.register
~service:W.S.election_cast_post
(if_eligible can_read
(fun user (ballot_raw, ballot_file) ->
......@@ -503,16 +500,12 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
Lwt_stream.to_string (Lwt_io.chars_of_file fname)
| _, _ -> fail_http 400
in
let module X : SAVED_SERVICE = struct
let uuid = W.election.e_params.e_uuid
let s = W.S.election_cast
end in
let x = (module X : SAVED_SERVICE) in
Eliom_reference.set S.saved_service x >>
let cont () () = Redirection.send W.S.election_cast in
Eliom_reference.set S.cont cont >>
Eliom_reference.set ballot (Some the_ballot) >>
match user with
| None -> return (Eliom_service.preapply S.login None)
| Some u -> S.cont ()
| None -> S.do_login cont ()
| Some u -> cont () ()
)
)
......
......@@ -24,17 +24,6 @@ open Serializable_t
open Web_serializable_t
open Signatures
module type SAVED_SERVICE = sig
val s :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[> Eliom_service.registrable ], 'a)
Eliom_service.service
end
type election_config = {
raw_election : string;
metadata : metadata;
......@@ -72,8 +61,6 @@ module type CORE_SERVICES = sig
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val saved_service : (module SAVED_SERVICE) Eliom_reference.eref
end
module type ELECTION_SERVICES = sig
......@@ -157,17 +144,6 @@ module type ELECTION_SERVICES = sig
end
module type CONT_SERVICE = sig
val cont :
unit ->
(unit, unit,
[> `Attached of
([> `External | `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit, Eliom_service.registrable, 'a)
Eliom_service.service Lwt.t
end
type service_handler = unit ->
(Eliom_registration.browser_content,
Eliom_registration.http_service
......@@ -270,13 +246,14 @@ end
module type SITE_SERVICES = sig
include CORE_SERVICES
include CONT_SERVICE
include AUTH_SERVICES
val register_election : election_config -> (module WEB_ELECTION) Lwt.t
val set_main_election : (module WEB_ELECTION) -> unit
val unset_main_election : unit -> unit
val cont : (unit -> service_handler) Eliom_reference.eref
end
module type TEMPLATES = sig
......
......@@ -76,13 +76,8 @@ module Make (C : CONFIG) : SITE_SERVICES = struct
~get_params:unit
()
let saved_service = Eliom_reference.eref ~scope
(module struct let s = home end : SAVED_SERVICE)
let cont () =
lwt x = Eliom_reference.get saved_service in
let module X = (val x : SAVED_SERVICE) in
return X.s
let cont = Eliom_reference.eref ~scope
(fun () () -> Eliom_registration.Redirection.send home)
let register_election config = !register_election_ref config
......@@ -108,7 +103,7 @@ module Make (C : CONFIG) : SITE_SERVICES = struct
let () = Any.register ~service:home
(fun () () ->
Eliom_reference.unset saved_service >>
Eliom_reference.unset cont >>
match !main_election with
| None ->
T.home ~featured:!featured () >>= Html5.send
......
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