Commit f2c1fc0e authored by Stephane Glondu's avatar Stephane Glondu

Group global service declarations

parent bcb7a0ce
......@@ -9,6 +9,7 @@ Election
Web_serializable_j
Web_common
Web_services
Web_auth
Web_election
Web_site
......
......@@ -28,6 +28,7 @@ open Common
open Web_serializable_t
open Web_signatures
open Web_common
open Web_services
let ( / ) = Filename.concat
......@@ -277,8 +278,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
open Eliom_registration
module L = struct
let login x = Eliom_service.preapply S.election_login ((W.election.e_params.e_uuid, ()), x)
let logout = Eliom_service.preapply S.election_logout (W.election.e_params.e_uuid, ())
let login x = Eliom_service.preapply election_login ((W.election.e_params.e_uuid, ()), x)
let logout = Eliom_service.preapply election_logout (W.election.e_params.e_uuid, ())
end
include Auth.Register (S) (T.Login (W.S) (L))
......@@ -304,7 +305,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let cont () () =
Redirection.send
(Eliom_service.preapply
S.election_home (W.election.e_params.e_uuid, ()))
election_home (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set S.cont cont >>
match_lwt Eliom_reference.get cast_confirmed with
......@@ -344,7 +345,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let cont () () =
Redirection.send
(Eliom_service.preapply
S.election_dir
election_dir
(W.election.e_params.e_uuid, f))
in
Eliom_reference.set S.cont cont >>
......@@ -389,7 +390,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let cont () () =
Redirection.send
(Eliom_service.preapply
S.election_vote (W.election.e_params.e_uuid, ()))
election_vote (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set S.cont cont >>
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
......@@ -423,7 +424,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let cont () () =
Redirection.send
(Eliom_service.preapply
S.election_home (W.election.e_params.e_uuid, ()))
election_home (W.election.e_params.e_uuid, ()))
in
W.H.do_logout cont ()
) else forbidden ()
......@@ -441,7 +442,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let cont () () =
Redirection.send
(Eliom_service.preapply
S.election_cast (W.election.e_params.e_uuid, ()))
election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set S.cont cont >>
match_lwt Eliom_reference.get ballot with
......@@ -463,7 +464,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let cont () () =
Redirection.send
(Eliom_service.preapply
S.election_cast (W.election.e_params.e_uuid, ()))
Web_services.election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set S.cont cont >>
Eliom_reference.set ballot (Some the_ballot) >>
......
(**************************************************************************)
(* 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 Eliom_service
open Eliom_service.Http
open Eliom_parameter
open Web_common
let home = service ~path:[""] ~get_params:unit ()
let admin = service ~path:["admin"] ~get_params:unit ()
let site_login = service ~path:["login"] ~get_params:(opt (string "service")) ()
let site_logout = service ~path:["logout"] ~get_params:unit ()
let source_code = service ~path:["belenios.tar.gz"] ~get_params:unit ()
let get_randomness = service ~path:["get-randomness"] ~get_params:unit ()
let new_election = service ~path:["new-election"] ~get_params:unit ()
let new_election_post = post_service ~fallback:new_election ~post_params:(file "election" ** file "metadata" ** file "public_keys" ** file "public_creds") ()
let tool = preapply (static_dir ()) ["static"; "belenios-tool.html"]
let election_setup_index = service ~path:["setup"; ""] ~get_params:unit ()
let election_setup_new = post_coservice ~csrf_safe:true ~fallback:election_setup_index ~post_params:unit ()
let election_setup = service ~path:["setup"; "election"] ~get_params:(uuid "uuid") ()
let election_setup_group = post_coservice ~fallback:election_setup ~post_params:(string "group") ()
let election_setup_metadata = post_coservice ~fallback:election_setup ~post_params:(string "metadata") ()
let election_setup_questions = post_coservice ~fallback:election_setup ~post_params:(string "questions") ()
let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:unit ()
let election_setup_credentials = service ~path:["setup"; "credentials"] ~get_params:(string "token") ()
let election_setup_credentials_download = service ~path:["setup"; "public_creds.txt"] ~get_params:(string "token") ()
let election_setup_credentials_post = post_coservice ~fallback:election_setup_credentials ~post_params:(string "public_creds") ()
let election_setup_credentials_post_file = post_coservice ~fallback:election_setup_credentials ~post_params:(file "public_creds") ()
let election_setup_trustee = service ~path:["setup"; "trustee"] ~get_params:(string "token") ()
let election_setup_trustee_post = post_coservice ~fallback:election_setup_trustee ~post_params:(string "public_key") ()
let election_setup_create = post_coservice ~csrf_safe:true ~fallback:election_setup ~post_params:unit ()
let election_home = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "")) ()
let election_admin = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "admin")) ()
let election_login = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "login") (opt (string "service"))) ()
let election_logout = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "logout")) ()
let election_set_featured = post_coservice ~fallback:election_admin ~post_params:(bool "featured") ()
let election_update_credential = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "update-cred")) ()
let election_update_credential_post = post_service ~fallback:election_update_credential ~post_params:(string "old_credential" ** string "new_credential") ()
let election_vote = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "vote")) ()
let election_cast = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "cast")) ()
let election_cast_post = post_service ~fallback:election_cast ~post_params:(opt (string "encrypted_vote") ** opt (file "encrypted_vote_file")) ()
let election_cast_confirm = post_coservice ~csrf_safe:true ~fallback:election_cast ~post_params:unit ()
let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) ()
This diff is collapsed.
......@@ -27,6 +27,7 @@ open Common
open Web_serializable_j
open Web_common
open Web_signatures
open Web_services
module type CONFIG = sig
val name : string
......@@ -71,8 +72,6 @@ module Make (C : CONFIG) : SITE = struct
let kind = `Site
end
let make_path x = C.path @ x
module Auth = Web_auth.Make (C)
module LwtRandom = MakeLwtRandom (struct let rng = make_rng () end)
......@@ -117,202 +116,6 @@ module Make (C : CONFIG) : SITE = struct
let scope = Eliom_common.default_session_scope
let home = service
~path:(make_path [""])
~get_params:unit
()
let admin = service
~path:(make_path ["admin"])
~get_params:unit
()
let site_login =
service
~path:(make_path ["login"])
~get_params:(opt (string "service"))
()
let site_logout =
service
~path:(make_path ["logout"])
~get_params:unit
()
let source_code = service
~path:(make_path ["belenios.tar.gz"])
~get_params:unit
()
let get_randomness = service
~path:(make_path ["get-randomness"])
~get_params:unit
()
let new_election = service
~path:(make_path ["new-election"])
~get_params:unit
()
let new_election_post = post_service
~fallback:new_election
~post_params:(
file "election" ** file "metadata"
** file "public_keys" ** file "public_creds"
) ()
let tool =
preapply (static_dir ()) ["static"; "belenios-tool.html"]
let election_setup_index = service
~path:(make_path ["setup"; ""])
~get_params:unit
()
let election_setup_new = post_coservice
~csrf_safe:true
~fallback:election_setup_index
~post_params:unit
()
let election_setup = service
~path:(make_path ["setup"; "election"])
~get_params:(uuid "uuid")
()
let election_setup_group = post_coservice
~fallback:election_setup
~post_params:(string "group")
()
let election_setup_metadata = post_coservice
~fallback:election_setup
~post_params:(string "metadata")
()
let election_setup_questions = post_coservice
~fallback:election_setup
~post_params:(string "questions")
()
let election_setup_trustee_add = post_coservice
~fallback:election_setup
~post_params:unit
()
let election_setup_credentials = service
~path:(make_path ["setup"; "credentials"])
~get_params:(string "token")
()
let election_setup_credentials_download =
service
~path:(make_path ["setup"; "public_creds.txt"])
~get_params:(string "token")
()
let election_setup_credentials_post = post_coservice
~fallback:election_setup_credentials
~post_params:(string "public_creds")
()
let election_setup_credentials_post_file = post_coservice
~fallback:election_setup_credentials
~post_params:(file "public_creds")
()
let election_setup_trustee = service
~path:(make_path ["setup"; "trustee"])
~get_params:(string "token")
()
let election_setup_trustee_post = post_coservice
~fallback:election_setup_trustee
~post_params:(string "public_key")
()
let election_setup_create =
post_coservice
~csrf_safe:true
~fallback:election_setup
~post_params:unit
()
let election_home =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** suffix_const ""))
()
let election_admin =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** suffix_const "admin"))
()
let election_login =
service
~path:(make_path ["elections"])
~get_params:(suffix_prod
(uuid "uuid" ** suffix_const "login")
(opt (string "service")))
()
let election_logout =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** suffix_const "logout"))
()
let election_set_featured =
post_coservice
~fallback:election_admin
~post_params:(bool "featured")
()
let election_update_credential =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** suffix_const "update-cred"))
()
let election_update_credential_post =
post_service
~fallback:election_update_credential
~post_params:(string "old_credential" ** string "new_credential")
()
let election_vote =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** suffix_const "vote"))
()
let election_cast =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** suffix_const "cast"))
()
let election_cast_post =
post_service
~fallback:election_cast
~post_params:(opt (string "encrypted_vote") ** opt (file "encrypted_vote_file"))
()
let election_cast_confirm =
post_coservice
~csrf_safe:true
~fallback:election_cast
~post_params:unit
()
let election_dir =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** election_file "file"))
()
let cont = Eliom_reference.eref ~scope
(fun () () -> Eliom_registration.Redirection.send home)
......@@ -500,8 +303,8 @@ module Make (C : CONFIG) : SITE = struct
) election_ptable
module L = struct
let login x = Eliom_service.preapply S.site_login x
let logout = Eliom_service.preapply S.site_logout ()
let login x = Eliom_service.preapply site_login x
let logout = Eliom_service.preapply site_logout ()
end
module Z = Auth.Register (S) (T.Login (S) (L))
......@@ -519,7 +322,7 @@ module Make (C : CONFIG) : SITE = struct
| Some x ->
let module W = (val SMap.find x !election_table : WEB_ELECTION) in
Redirection.send
(preapply S.election_home (W.election.e_params.e_uuid, ()))
(preapply election_home (W.election.e_params.e_uuid, ()))
)
let () = Html5.register ~service:admin
......@@ -597,7 +400,7 @@ module Make (C : CONFIG) : SITE = struct
lwt w = W.register () in
let module W = (val w : WEB_ELECTION) in
Redirection.send
(preapply S.election_admin (W.election.e_params.e_uuid, ()))
(preapply election_admin (W.election.e_params.e_uuid, ()))
end
with e ->
T.new_election_failure (`Exception e) () >>= Html5.send
......@@ -927,7 +730,7 @@ module Make (C : CONFIG) : SITE = struct
se.se_public_keys >>
Ocsipersist.remove election_stable uuid_s >>
Redirection.send
(preapply S.election_admin (W.election.e_params.e_uuid, ()))
(preapply election_admin (W.election.e_params.e_uuid, ()))
end
)
with e ->
......@@ -954,7 +757,7 @@ module Make (C : CONFIG) : SITE = struct
else S.remove_featured_election uuid_s
in
Redirection.send
(preapply S.election_admin (uuid, ())))
(preapply election_admin (uuid, ())))
let () =
Any.register
......
This diff is collapsed.
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