web_signatures.mli 6.7 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
(**************************************************************************)
(*                                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/>.                                       *)
(**************************************************************************)

22
open Serializable_builtin_t
Stephane Glondu's avatar
Stephane Glondu committed
23
open Serializable_t
24
open Signatures
Stephane Glondu's avatar
Stephane Glondu committed
25
open Common
Stephane Glondu's avatar
Stephane Glondu committed
26
open Web_serializable_t
27

28 29
module type AUTH_SERVICES = sig

30 31
  val auth_realm : string

32 33 34
  val get_auth_systems : unit -> string list
  val get_user : unit -> user option Lwt.t

35 36 37 38
end

module type AUTH_LINKS = sig

39
  val login :
40 41
    string option ->
    (unit, unit,
42 43 44
     [> `Attached of
          ([> `Internal of [> `Service ] ], [> `Get ])
          Eliom_service.a_s ],
45 46
     [ `WithoutSuffix ], unit, unit,
     [< Eliom_service.registrable > `Unregistrable ],
Stephane Glondu's avatar
Stephane Glondu committed
47
     [> Eliom_service.http_service ])
48 49 50 51 52 53 54 55
    Eliom_service.service

  val logout :
    (unit, unit,
     [> `Attached of
          ([> `Internal of [> `Service ] ], [> `Get ])
          Eliom_service.a_s ],
     [ `WithoutSuffix ], unit, unit,
56
     [< Eliom_service.registrable > `Unregistrable ],
Stephane Glondu's avatar
Stephane Glondu committed
57
     [> Eliom_service.http_service ])
58 59 60 61
    Eliom_service.service

end

62 63 64 65 66
type content =
    Eliom_registration.browser_content Eliom_registration.kind Lwt.t

module type ELECTION_HANDLERS =
  sig
67 68
    val login : string option -> unit -> content
    val logout : unit -> unit -> content
69
    val home : unit -> unit -> content
70 71 72 73
    val admin : user option -> bool -> unit -> unit -> content
    val election_dir : user option -> Web_common.election_file -> unit -> content
    val election_update_credential : user option -> unit -> unit -> content
    val election_update_credential_post : user option -> unit -> string * string -> content
74 75 76 77
    val election_vote : unit -> unit -> content
    val election_cast : unit -> unit -> content
    val election_cast_post :
      unit -> string option * Eliom_lib.file_info option -> content
78
    val election_cast_confirm : unit -> unit -> content
79 80
    val election_pretty_ballots : int -> unit -> content
    val election_pretty_ballot : string -> unit -> content
81 82
  end

83 84 85 86 87 88
module type AUTH_HANDLERS_RAW =
  sig
    val login : string option -> unit -> content
    val logout : unit -> unit -> content
  end

89
type service_handler = unit ->
Stephane Glondu's avatar
Stephane Glondu committed
90
  Eliom_registration.browser_content Eliom_registration.kind Lwt.t
91 92 93 94 95 96 97 98

type 'a service_cont = ('a -> service_handler) -> service_handler

module type AUTH_HANDLERS = sig
  val login : string service_cont
  val logout : unit service_cont
end

99
module type AUTH_HANDLERS_PUBLIC = sig
100
  val do_login : string option -> unit service_cont
101 102 103
  val do_logout : unit service_cont
end

104
module type WEB_BALLOT_BOX = sig
105
  module Ballots : MONADIC_MAP_RO
106 107 108
    with type 'a m = 'a Lwt.t
    and type elt = string
    and type key = string
109
  module Records : MONADIC_MAP_RO
110
    with type 'a m = 'a Lwt.t
111
    and type elt = datetime * string
112 113 114
    and type key = string

  val cast : string -> string * datetime -> string Lwt.t
115
  val inject_cred : string -> unit Lwt.t
116
  val update_files : unit -> unit Lwt.t
117 118 119
  val update_cred : old:string -> new_:string -> unit Lwt.t
end

120
module type WEB_PARAMS = sig
121
  val metadata : metadata
122
  val dir : string
123
end
124

125
module type WEB_ELECTION_ = sig
126 127 128
  include ELECTION_DATA
  include WEB_PARAMS
  module E : ELECTION with type elt = G.t
Stephane Glondu's avatar
Stephane Glondu committed
129
  module S : AUTH_SERVICES
130 131 132
  module B : WEB_BALLOT_BOX
end

133 134 135 136 137
module type WEB_ELECTION = sig
  include WEB_ELECTION_
  module Z : ELECTION_HANDLERS
end

138 139 140 141 142 143 144
type election_files = {
  f_election : string;
  f_metadata : string;
  f_public_keys : string;
  f_public_creds : string;
}

145 146 147 148 149
module type REGISTRABLE_ELECTION = sig
  val discard : unit -> unit
  val register : unit -> (module WEB_ELECTION) Lwt.t
end

150
module type LOGIN_TEMPLATES = sig
151

152
  val dummy :
153 154 155 156
    service:(unit, 'a, [< Eliom_service.post_service_kind ],
             [< Eliom_service.suff ], 'b,
             [< string Eliom_parameter.setoneradio ]
             Eliom_parameter.param_name,
Stephane Glondu's avatar
Stephane Glondu committed
157 158
             [< Eliom_service.registrable ],
             [< Eliom_service.non_ocaml_service ])
159
            Eliom_service.service ->
160
    unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
161

162
  val password :
163 164 165 166 167 168
    service:(unit, 'a, [< Eliom_service.post_service_kind ],
             [< Eliom_service.suff ], 'b,
             [< string Eliom_parameter.setoneradio ]
             Eliom_parameter.param_name *
             [< string Eliom_parameter.setoneradio ]
             Eliom_parameter.param_name,
Stephane Glondu's avatar
Stephane Glondu committed
169 170
             [< Eliom_service.registrable ],
             [< Eliom_service.non_ocaml_service ])
171 172 173 174 175 176 177 178
            Eliom_service.service ->
    unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t

  val upload_password_db :
    service:(unit, 'a, [< Eliom_service.post_service_kind ],
             [< Eliom_service.suff ], 'b,
             [< Eliom_lib.file_info Eliom_parameter.setoneradio ]
             Eliom_parameter.param_name,
Stephane Glondu's avatar
Stephane Glondu committed
179 180
             [< Eliom_service.registrable ],
             [< Eliom_service.non_ocaml_service ])
181
            Eliom_service.service ->
182
    unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
183

184 185 186 187 188
  val choose :
    unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t

end

189 190
module type NAME = sig
  val name : string
191
  val path : string list
192
  val kind : [ `Site | `Election of string ]
193 194
end

195 196
module type AUTH_SERVICE =
  functor (N : NAME) ->
197
  functor (T : LOGIN_TEMPLATES) ->
198
  AUTH_HANDLERS
199 200 201 202 203 204 205 206 207 208 209 210 211

module type AUTH_SYSTEM = sig
  type config

  val name : string

  val parse_config :
    instance:string ->
    attributes:(string * string) list ->
    config

  val make : config -> (module AUTH_SERVICE)
end