services.ml 3.81 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1
open Util
2
open Serializable_t
3 4 5
open Eliom_service
open Eliom_parameter

Stephane Glondu's avatar
Stephane Glondu committed
6
let home = service
Stephane Glondu's avatar
Stephane Glondu committed
7 8 9
  ~path:[]
  ~get_params:unit
  ()
Stephane Glondu's avatar
Stephane Glondu committed
10

Stephane Glondu's avatar
Stephane Glondu committed
11 12 13 14 15
let source_code = service
  ~path:["belenios.tar.gz"]
  ~get_params:unit
  ()

16 17
let login_dummy = service
  ~path:["login-dummy"]
18 19
  ~get_params:unit
  ()
Stephane Glondu's avatar
Stephane Glondu committed
20

Stephane Glondu's avatar
Stephane Glondu committed
21 22 23 24 25
let login_admin = service
  ~path:["login-admin"]
  ~get_params:unit
  ()

Stephane Glondu's avatar
Stephane Glondu committed
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
let cas_server = "https://cas.inria.fr"

let cas_login = external_service
  ~prefix:cas_server
  ~path:["cas"; "login"]
  ~get_params:Eliom_parameter.(string "service")
  ()

let cas_logout = external_service
  ~prefix:cas_server
  ~path:["cas"; "logout"]
  ~get_params:Eliom_parameter.(string "service")
  ()

let cas_validate = external_service
  ~prefix:cas_server
  ~path:["cas"; "validate"]
  ~get_params:Eliom_parameter.(string "service" ** string "ticket")
  ()

let login_cas = service
  ~path:["login-cas"]
  ~get_params:Eliom_parameter.(opt (string "ticket"))
  ()

Stephane Glondu's avatar
Stephane Glondu committed
51 52 53 54 55
let logout = service
  ~path:["logout"]
  ~get_params:unit
  ()

Stephane Glondu's avatar
Stephane Glondu committed
56
let create_string_login ~fallback =
Stephane Glondu's avatar
Stephane Glondu committed
57 58
  Eliom_service.post_coservice
    ~csrf_safe:true
Stephane Glondu's avatar
Stephane Glondu committed
59
    ~csrf_scope:Eliom_common.default_session_scope
Stephane Glondu's avatar
Stephane Glondu committed
60
    ~fallback
61
    ~post_params:Eliom_parameter.(string "username")
Stephane Glondu's avatar
Stephane Glondu committed
62
    ()
Stephane Glondu's avatar
Stephane Glondu committed
63 64

let user = Eliom_reference.eref
Stephane Glondu's avatar
Stephane Glondu committed
65
  ~scope:Eliom_common.default_session_scope
Stephane Glondu's avatar
Stephane Glondu committed
66
  (None : Web_common.user option)
Stephane Glondu's avatar
Stephane Glondu committed
67

Stephane Glondu's avatar
Stephane Glondu committed
68 69 70 71
let ballot = Eliom_reference.eref
  ~scope:Eliom_common.default_session_scope
  (None : string option)

72 73 74 75 76 77 78
let uuid = Eliom_parameter.user_type
  (fun x -> match Uuidm.of_string x with
    | Some x -> x
    | None -> invalid_arg "uuid")
  Uuidm.to_string
  "uuid"

Stephane Glondu's avatar
Stephane Glondu committed
79
(* TODO: put uuid in url instead of GET parameter *)
Stephane Glondu's avatar
Stephane Glondu committed
80

Stephane Glondu's avatar
Stephane Glondu committed
81
let election_index = service
82
  ~path:["election"; ""]
Stephane Glondu's avatar
Stephane Glondu committed
83 84 85
  ~get_params:uuid
  ()

Stephane Glondu's avatar
Stephane Glondu committed
86
let election_raw = service
Stephane Glondu's avatar
Stephane Glondu committed
87
  ~path:["election"; "election.json"]
88
  ~get_params:uuid
Stephane Glondu's avatar
Stephane Glondu committed
89 90
  ()

91
let election_public_keys = service
Stephane Glondu's avatar
Stephane Glondu committed
92
  ~path:["election"; "public_keys.jsons"]
93 94 95
  ~get_params:uuid
  ()

96 97 98 99 100
let election_public_creds = service
  ~path:["election"; "public_creds.txt"]
  ~get_params:uuid
  ()

Stephane Glondu's avatar
Stephane Glondu committed
101
let election_vote = service
102
  ~path:["election"; "vote"]
Stephane Glondu's avatar
Stephane Glondu committed
103 104 105
  ~get_params:uuid
  ()

106 107 108 109 110
let election_cast = service
  ~path:["election"; "cast"]
  ~get_params:uuid
  ()

Stephane Glondu's avatar
Stephane Glondu committed
111
let election_ballots = service
Stephane Glondu's avatar
Stephane Glondu committed
112
  ~path:["election"; "ballots.jsons"]
Stephane Glondu's avatar
Stephane Glondu committed
113 114 115
  ~get_params:uuid
  ()

Stephane Glondu's avatar
Stephane Glondu committed
116 117 118 119 120
let election_records = service
  ~path:["election"; "records"]
  ~get_params:uuid
  ()

121 122
let election_cast_post = post_service
  ~fallback:election_cast
Stephane Glondu's avatar
Stephane Glondu committed
123
  ~post_params:(opt (string "encrypted_vote") ** opt (file "encrypted_vote_file"))
Stephane Glondu's avatar
Stephane Glondu committed
124
  ()
125

Stephane Glondu's avatar
Stephane Glondu committed
126 127 128 129 130 131 132 133 134 135
let election_update_credential_form = service
  ~path:["election"; "update-cred"]
  ~get_params:uuid
  ()

let election_update_credential = post_service
  ~fallback:election_update_credential_form
  ~post_params:(string "old_credential" ** string "new_credential")
  ()

Stephane Glondu's avatar
Stephane Glondu committed
136 137 138 139 140 141 142 143
let create_confirm () =
  Eliom_service.post_coservice
    ~csrf_safe:true
    ~csrf_scope:Eliom_common.default_session_scope
    ~fallback:election_cast
    ~post_params:Eliom_parameter.unit
    ()

Stephane Glondu's avatar
Stephane Glondu committed
144 145 146 147
let get_randomness = service
  ~path:["get-randomness"]
  ~get_params:unit
  ()
Stephane Glondu's avatar
Stephane Glondu committed
148

Stephane Glondu's avatar
Stephane Glondu committed
149 150 151
let election_booth = static_dir_with_params
  ~get_params:(string "election_url")
  ()
Stephane Glondu's avatar
Stephane Glondu committed
152

Stephane Glondu's avatar
Stephane Glondu committed
153 154 155 156 157 158
let make_booth uuid =
  let service = Eliom_service.preapply election_raw uuid in
  Eliom_service.preapply election_booth (
    ["booth"; "vote.html"],
    Eliom_uri.make_string_uri ~absolute_path:true ~service ()
  )
159

160
let preapply_uuid s e = Eliom_service.preapply s e.Web_common.params.e_uuid
161 162 163

type savable_service =
  | Home
Stephane Glondu's avatar
Stephane Glondu committed
164 165
  | Cast of Uuidm.t
  | Election of Uuidm.t
166 167 168 169 170 171 172

let saved_service = Eliom_reference.eref
  ~scope:Eliom_common.default_session_scope
  Home

let to_service = function
  | Home -> home
Stephane Glondu's avatar
Stephane Glondu committed
173 174
  | Cast u -> Eliom_service.preapply election_cast u
  | Election u -> Eliom_service.preapply election_index u
175 176 177 178 179 180 181 182

open Lwt

let get () =
  Eliom_reference.get saved_service >>= wrap1 to_service

let set s =
  Eliom_reference.set saved_service s