Commit 7700cecd authored by Stephane Glondu's avatar Stephane Glondu

Add the possibility to hide the result from the public

parent 5ef5de1a
Pipeline #77776 passed with stages
in 16 minutes and 40 seconds
......@@ -44,6 +44,17 @@ let get_election_result uuid =
| Some [x] -> return (Some (election_result_of_string Yojson.Safe.read_json x))
| _ -> return_none
let get_election_result_hidden uuid =
Lwt_unix.file_exists (!Web_config.spool_dir / raw_string_of_uuid uuid / "hide_result")
let set_election_result_hidden uuid hidden =
if hidden then (
write_file ~uuid "hide_result" []
) else (
try%lwt Lwt_unix.unlink (!Web_config.spool_dir / raw_string_of_uuid uuid / "hide_result")
with _ -> return_unit
)
type election_date =
[ `Creation
| `Validation
......
......@@ -59,6 +59,9 @@ val get_raw_election : uuid -> string option Lwt.t
val get_election_metadata : uuid -> metadata Lwt.t
val get_election_result : uuid -> Yojson.Safe.json election_result option Lwt.t
val get_election_result_hidden : uuid -> bool Lwt.t
val set_election_result_hidden : uuid -> bool -> unit Lwt.t
type election_kind =
[ `Draft
| `Validated
......
......@@ -83,6 +83,8 @@ let election_regenpwd_post = create_attached_post ~fallback:election_regenpwd ~p
let election_login = create ~path:(Path ["elections"]) ~meth:(Get (suffix_prod (uuid "uuid" ** suffix_const "login") (opt (string "service")))) ()
let election_open = create_attached_post ~fallback:election_admin ~post_params:unit ()
let election_close = create_attached_post ~fallback:election_admin ~post_params:unit ()
let election_hide_result = create_attached_post ~fallback:election_admin ~post_params:unit ()
let election_show_result = create_attached_post ~fallback:election_admin ~post_params:unit ()
let election_auto_post = create_attached_post ~fallback:election_admin ~post_params:(string "open" ** string "close") ()
let election_archive = create_attached_post ~fallback:election_admin ~post_params:unit ()
let election_delete = create_attached_post ~fallback:election_admin ~post_params:unit ()
......
......@@ -321,6 +321,7 @@ let delete_election uuid =
"threshold.json";
"records";
"result.json";
"hide_result";
"voters.txt";
"archive.zip";
]
......@@ -1276,6 +1277,18 @@ let election_set_state state uuid () =
let () = Any.register ~service:election_open (election_set_state true)
let () = Any.register ~service:election_close (election_set_state false)
let election_set_result_hidden hidden uuid () =
with_site_user (fun u ->
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
let%lwt () = Web_persist.set_election_result_hidden uuid hidden in
redir_preapply election_admin uuid ()
) else forbidden ()
)
let () = Any.register ~service:election_hide_result (election_set_result_hidden true)
let () = Any.register ~service:election_show_result (election_set_result_hidden false)
let () =
Any.register ~service:election_auto_post
(fun uuid (auto_open, auto_close) ->
......@@ -1817,10 +1830,11 @@ let content_type_of_file = function
| ESCreds | ESRecords | ESVoters -> "text/plain"
let handle_pseudo_file uuid f site_user =
let confidential =
let%lwt confidential =
match f with
| ESRaw | ESKeys | ESTParams | ESBallots | ESETally | ESResult | ESCreds -> false
| ESRecords | ESVoters -> true
| ESRaw | ESKeys | ESTParams | ESBallots | ESETally | ESCreds -> return false
| ESRecords | ESVoters -> return true
| ESResult -> Web_persist.get_election_result_hidden uuid
in
let%lwt () =
if confidential then (
......
......@@ -1747,8 +1747,14 @@ let election_home election state () =
in
let%lwt middle =
let%lwt result = Web_persist.get_election_result uuid in
let%lwt hidden = Web_persist.get_election_result_hidden uuid in
let%lwt is_admin =
let%lwt metadata = Web_persist.get_election_metadata uuid in
let%lwt site_user = Eliom_reference.get Web_state.site_user in
return (metadata.e_owner = site_user)
in
match result with
| Some r ->
| Some r when not hidden || is_admin ->
let result = r.result in
let questions = Array.to_list election.e_params.e_questions in
return @@ div [
......@@ -1786,6 +1792,11 @@ let election_home election state () =
pcdata ".";
];
]
| Some _ ->
return @@
div [
pcdata "The result for this election is currently not publicly available.";
]
| None -> return go_to_the_booth
in
let languages =
......@@ -2026,8 +2037,22 @@ let election_admin election metadata state get_tokens_decrypt () =
release_form;
]
| `Tallied ->
let%lwt hidden = Web_persist.get_election_result_hidden uuid in
let form_toggle =
if hidden then
post_form ~service:election_show_result
(fun () ->
[input ~input_type:`Submit ~value:"Publish the result" string]
) uuid
else
post_form ~service:election_hide_result
(fun () ->
[input ~input_type:`Submit ~value:"Hide the result" string]
) uuid
in
return @@ div [
pcdata "This election has been tallied.";
form_toggle;
]
| `Archived ->
return @@ div [
......
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