Commit 0598011f authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Add an interface to Web_state, move services and erefs around

parent 0efa08df
......@@ -89,10 +89,5 @@ let election_tally_release = post_service ~fallback:election_admin ~post_params:
let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) ()
let scope = Eliom_common.default_session_scope
let ballot : string option Eliom_reference.eref =
Eliom_reference.eref ~scope None
let cast_confirmed : [ `Error of Web_common.error | `Valid of string ] option Eliom_reference.eref =
Eliom_reference.eref ~scope None
let dummy_post = post_coservice' ~post_params:(string "username") ()
let password_post = post_coservice' ~post_params:(string "username" ** string "password") ()
......@@ -904,16 +904,16 @@ let () =
try_lwt
lwt w = find_election uuid_s in
let module W = (val w) in
Eliom_reference.unset Web_services.ballot >>
Eliom_reference.unset Web_state.ballot >>
let cont () =
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_state.cont [cont] >>
match_lwt Eliom_reference.get Web_services.cast_confirmed with
match_lwt Eliom_reference.get Web_state.cast_confirmed with
| Some result ->
Eliom_reference.unset Web_services.cast_confirmed >>
Eliom_reference.unset Web_state.cast_confirmed >>
T.cast_confirmed (module W) ~result () >>= Html5.send
| None ->
lwt state = Web_persist.get_election_state uuid_s in
......@@ -1028,7 +1028,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
lwt w = find_election uuid_s in
let module W = (val w) in
Eliom_reference.unset Web_services.ballot >>
Eliom_reference.unset Web_state.ballot >>
Redirection.send
(Eliom_service.preapply
(Eliom_service.static_dir_with_params
......@@ -1049,7 +1049,7 @@ let () =
election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_state.cont [cont] >>
match_lwt Eliom_reference.get Web_services.ballot with
match_lwt Eliom_reference.get Web_state.ballot with
| Some b -> T.cast_confirmation (module W) (sha256_b64 b) () >>= Html5.send
| None -> T.cast_raw (module W) () >>= Html5.send)
......@@ -1074,7 +1074,7 @@ let () =
Web_services.election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_state.cont [cont] >>
Eliom_reference.set Web_services.ballot (Some the_ballot) >>
Eliom_reference.set Web_state.ballot (Some the_ballot) >>
match user with
| None ->
Redirection.send
......@@ -1091,10 +1091,10 @@ let () =
lwt w = find_election uuid_s in
let module W = (val w) in
let module WE = Web_election.Make (W) (LwtRandom) in
match_lwt Eliom_reference.get Web_services.ballot with
match_lwt Eliom_reference.get Web_state.ballot with
| Some the_ballot ->
begin
Eliom_reference.unset Web_services.ballot >>
Eliom_reference.unset Web_state.ballot >>
match_lwt Web_state.get_election_user uuid with
| Some u ->
let record = u, now () in
......@@ -1104,7 +1104,7 @@ let () =
return (`Valid hash)
with Error e -> return (`Error e)
in
Eliom_reference.set Web_services.cast_confirmed (Some result) >>
Eliom_reference.set Web_state.cast_confirmed (Some result) >>
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
......
......@@ -32,8 +32,7 @@ type user = {
let scope = Eliom_common.default_session_scope
let user : user option Eliom_reference.eref =
Eliom_reference.eref ~scope None
let user = Eliom_reference.eref ~scope None
let get_site_user () =
match_lwt Eliom_reference.get user with
......@@ -62,6 +61,7 @@ let get_election_user uuid =
else
return None
let get_config uuid =
let uuid_s =
match uuid with
......@@ -70,8 +70,8 @@ let get_config uuid =
in
Web_persist.get_auth_config uuid_s
let cont : (unit -> content) list Eliom_reference.eref =
Eliom_reference.eref ~scope []
let cont = Eliom_reference.eref ~scope []
let cont_push f =
let open Eliom_reference in
......@@ -85,10 +85,6 @@ let cont_pop () =
| f :: fs -> set cont fs >> return (Some f)
| [] -> return None
let dummy_post = Eliom_service.Http.post_coservice'
~post_params:(Eliom_parameter.string "username")
()
let password_post = Eliom_service.Http.post_coservice'
~post_params:Eliom_parameter.(string "username" ** string "password")
()
let ballot = Eliom_reference.eref ~scope None
let cast_confirmed = Eliom_reference.eref ~scope None
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2016 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
type user = {
uuid: Uuidm.t option;
service : string;
name : string;
logout : unit -> content;
}
val user : user option Eliom_reference.eref
val get_site_user : unit -> Web_serializable_t.user option Lwt.t
val get_election_user : Uuidm.t -> Web_serializable_t.user option Lwt.t
val get_config : Uuidm.t option -> (string * (string * string list)) list Lwt.t
val cont : (unit -> content) list Eliom_reference.eref
val cont_push : (unit -> content) -> unit Lwt.t
val cont_pop : unit -> (unit -> content) option Lwt.t
val ballot : string option Eliom_reference.eref
val cast_confirmed : [ `Error of Web_common.error | `Valid of string ] option Eliom_reference.eref
......@@ -1587,7 +1587,7 @@ let login_dummy () =
let title, field_name, input_type =
"Dummy login", "Username:", `Text
in
let form = post_form ~service:Web_state.dummy_post
let form = post_form ~service:dummy_post
(fun name ->
[
tablex [tbody [
......@@ -1608,7 +1608,7 @@ let login_dummy () =
base ~title ~login_box ~content ()
let login_password () =
let form = post_form ~service:Web_state.password_post
let form = post_form ~service:password_post
(fun (llogin, lpassword) ->
[
tablex [tbody [
......
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