Commit ac3a07eb authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Update credential service

parent 8c34b58a
......@@ -186,7 +186,7 @@ let forbidden () = fail_http 403
let check_acl acl election user =
let open Web_common in
match acl election with
match acl election user with
| Any -> return true
| Restricted p ->
match user with
......@@ -325,8 +325,9 @@ let () = Eliom_registration.Redirection.register
| _ -> Services.get ()
)
let can_read x = x.Web_common.can_read
let can_vote x = x.Web_common.can_vote
let can_read x u = x.Web_common.can_read
let can_vote x u = x.Web_common.can_vote
let can_admin x u = Web_common.is_admin u
let () = Eliom_registration.File.register
~service:Services.source_code
......@@ -517,3 +518,28 @@ let () = Eliom_registration.Redirection.register
| Some u -> Services.get ()
)
)
let () = Eliom_registration.Html5.register
~service:Services.election_update_credential_form
(fun uuid () ->
lwt user = Eliom_reference.get Services.user in
if Web_common.is_admin user then (
lwt election = get_election_by_uuid uuid in
Templates.election_update_credential ~election
) else forbidden ()
)
let () = Eliom_registration.String.register
~service:Services.election_update_credential
(fun uuid (old, new_) ->
lwt user = Eliom_reference.get Services.user in
if Web_common.is_admin user then (
lwt election = get_election_by_uuid uuid in
let module X = (val election : Web_common.WEB_ELECTION) in
try_lwt
X.B.update_cred ~old ~new_ >>
return ("OK", "text/plain")
with Web_common.Error e ->
return ("Error: " ^ Web_common.explain_error e, "text/plain")
) else forbidden ()
)
......@@ -127,6 +127,16 @@ let election_cast_post = post_service
~post_params:(string "encrypted_vote")
()
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")
()
let create_confirm () =
Eliom_service.post_coservice
~csrf_safe:true
......
......@@ -327,3 +327,27 @@ let do_cast_ballot ~election ~result =
];
] in
base ~title:name ~content
let election_update_credential ~election =
let module X = (val election : Web_common.WEB_ELECTION) in
let election = X.data in
let form = post_form ~service:Services.election_update_credential
(fun (old, new_) ->
[
div [
pcdata "Hash of the old credential: ";
string_input ~name:old ~input_type:`Text ~a:[a_size 64] ();
];
div [
pcdata "New credential: ";
string_input ~name:new_ ~input_type:`Text ~a:[a_size 617] ();
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) election.Web_common.election.e_uuid
in
let content = [
h1 [ pcdata election.Web_common.election.e_name ];
form;
] in
base ~title:election.Web_common.election.e_name ~content
......@@ -80,6 +80,8 @@ type error =
| RevoteNotAllowed
| ReusedCredential
| WrongCredential
| UsedCredential
| CredentialNotFound
exception Error of error
......@@ -95,6 +97,8 @@ let explain_error = function
| RevoteNotAllowed -> "you are not allowed to revote"
| ReusedCredential -> "your credential has already been used"
| WrongCredential -> "you are not allowed to vote with this credential"
| UsedCredential -> "the credential has already been used"
| CredentialNotFound -> "the credential has not been found"
module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
......@@ -108,6 +112,7 @@ module type WEB_BBOX = sig
val inject_creds : SSet.t -> unit Lwt.t
val extract_creds : unit -> SSet.t Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
end
let security_logfile = ref None
......@@ -266,6 +271,19 @@ module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) = struc
Ocsipersist.fold_step (fun k v x -> f (k, fst v) x) record_table x
let turnout = Ocsipersist.length ballot_table
let update_cred ~old ~new_ =
match_lwt Ocsipersist.fold_step (fun k v x ->
if sha256_hex k = old then (
match v with
| Some _ -> fail UsedCredential
| None -> return (Some k)
) else return x
) cred_table None with
| None -> fail CredentialNotFound
| Some x ->
Ocsipersist.remove cred_table x >>
Ocsipersist.add cred_table new_ None
end
module type WEB_ELECTION = sig
......
......@@ -51,6 +51,8 @@ type error =
| RevoteNotAllowed
| ReusedCredential
| WrongCredential
| UsedCredential
| CredentialNotFound
exception Error of error
......@@ -68,6 +70,7 @@ module type WEB_BBOX = sig
val inject_creds : SSet.t -> unit Lwt.t
val extract_creds : unit -> SSet.t Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
end
module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) : WEB_BBOX
......
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