Trustees can compute and submit their decryption factors

_tags

@@ -2,5 +2,4 @@
 <src/platform/native/*>: package(zarith), package(calendar), package(cryptokit)
 <src/web/*.{ml,mli,byte,native,odoc}>: thread, package(eliom.server), syntax(camlp4o), package(lwt.syntax), package(csv)
 <src/tool/tool_cmdline.*>: package(zarith), package(calendar), package(cryptokit), package(cmdliner), use_platform-native
-<src/tool/tool_js*> or <src/platform/js/*> or <src/booth/*>: package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), use_platform-js
-<src/booth/*>: package(lwt.syntax)
+<src/tool/tool_js*> or <src/platform/js/*> or <src/booth/*>: package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), package(lwt.syntax), use_platform-js

all.itarget

@@ -6,3 +6,4 @@ src/static/vote.html.otarget
 src/static/tool_js_tkeygen.js
 src/static/tool_js_credgen.js
 src/static/tool_js_questions.js
+src/static/tool_js_pd.js

myocamlbuild.ml

@@ -123,6 +123,7 @@ let () = dispatch & function
     copy_rule "tool_js_tkeygen.js" "src/tool/tool_js_tkeygen.js" "src/static/tool_js_tkeygen.js";
     copy_rule "tool_js_credgen.js" "src/tool/tool_js_credgen.js" "src/static/tool_js_credgen.js";
     copy_rule "tool_js_questions.js" "src/tool/tool_js_questions.js" "src/static/tool_js_questions.js";
+    copy_rule "tool_js_pd.js" "src/tool/tool_js_pd.js" "src/static/tool_js_pd.js";
 
     List.iter
       copy_static

src/tool/tool_js_pd.ml

+(**************************************************************************)
+(*                                BELENIOS                                *)
+(*                                                                        *)
+(*  Copyright © 2012-2015 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 Platform
+open Serializable_j
+open Tool_js_common
+
+let election = ref None
+let encrypted_tally = ref None
+
+let ( >>= ) = Js.Opt.bind
+
+let wrap f x =
+  (try
+     Js.Opt.case (f x)
+       (fun () -> failwith "Unexpected error")
+       (fun () -> ())
+   with
+   | Failure s -> alert s
+   | e ->
+      Printf.ksprintf
+        alert "Unexpected error: %s" (Printexc.to_string e)
+  ); Js._false
+
+let compute_partial_decryption _ =
+  Js.Opt.option !election >>= fun e ->
+  let election = Group.election_params_of_string e in
+  let module P = (val election) in
+  let module M = Election.MakeSimpleMonad (P.G) in
+  let module E = Election.MakeElection (P.G) (M) in
+  Js.Opt.option !encrypted_tally >>= fun e ->
+  let encrypted_tally = encrypted_tally_of_string P.G.read e in
+  document##getElementById (Js.string "private_key") >>= fun e ->
+  Dom_html.CoerceTo.input e >>= fun e ->
+  let pk_str = Js.to_string e##value in
+  let private_key =
+    try number_of_string pk_str
+    with e ->
+      Printf.ksprintf
+        failwith "Error in format of private key: %s" (Printexc.to_string e)
+  in
+  let factor = E.compute_factor encrypted_tally private_key () in
+  set_textarea "pd" (string_of_partial_decryption P.G.write factor);
+  Js.some ()
+
+let compute_hash () =
+  let _ =
+    Js.Opt.option !encrypted_tally >>= fun e ->
+    let hash = sha256_b64 e in
+    document##getElementById (Js.string "hash") >>= fun e ->
+    let t = document##createTextNode (Js.string hash) in
+    Dom.appendChild e t;
+    Js.null
+  in Js._false
+
+let main _ =
+  let _ =
+    document##getElementById (Js.string "compute") >>= fun e ->
+    Dom_html.CoerceTo.button e >>= fun e ->
+    e##onclick <- Dom_html.handler (wrap compute_partial_decryption);
+    Js.null
+  in
+  let _ =
+    Lwt.async (fun () ->
+      let open XmlHttpRequest in
+      lwt e = get "../encrypted_tally.json" in
+      encrypted_tally := Some e.content;
+      lwt e = get "../election.json" in
+      election := Some e.content;
+      Lwt.return (compute_hash ()))
+  in
+  Js._false
+
+let () =
+  Dom_html.window##onload <- Dom_html.handler main

src/web/web_persist.ml

@@ -76,3 +76,12 @@ let set_main_election x =
 
 let unset_main_election () =
   Ocsipersist.set main_election None
+
+let election_pds = Ocsipersist.open_table "election_pds"
+
+let get_partial_decryptions x =
+  try_lwt Ocsipersist.find election_pds x
+  with Not_found -> return []
+
+let set_partial_decryptions x pds =
+  Ocsipersist.add election_pds x pds

src/web/web_persist.mli

@@ -35,3 +35,6 @@ val add_featured_election : string -> unit Lwt.t
 val remove_featured_election : string -> unit Lwt.t
 val is_featured_election : string -> bool Lwt.t
 val get_featured_elections : unit -> string list Lwt.t
+
+val get_partial_decryptions : string -> (int * string) list Lwt.t
+val set_partial_decryptions : string -> (int * string) list -> unit Lwt.t

src/web/web_services.ml

@@ -68,9 +68,12 @@ let election_cast_post = post_service ~fallback:election_cast ~post_params:(opt
 let election_cast_confirm = post_coservice ~csrf_safe:true ~fallback:election_cast ~post_params:unit ()
 let election_pretty_ballots = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "ballots") (int "start")) ()
 let election_pretty_ballot = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "ballot") (string "hash")) ()
-let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) ()
 
 let election_compute_encrypted_tally = post_coservice ~csrf_safe:true ~fallback:election_admin ~post_params:unit ()
+let election_tally_trustees = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "trustees" ** int "trustee_id")) ()
+let election_tally_trustees_post = post_service ~fallback:election_tally_trustees ~post_params:(string "partial_decryption") ()
+
+let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) ()
 
 let scope = Eliom_common.default_session_scope
 

src/web/web_site.ml

@@ -976,6 +976,67 @@ let () =
           (fun x -> return @@ cast_unknown_content_kind x)
      ) else forbidden ())
 
+let () =
+  Any.register
+    ~service:election_tally_trustees
+    (fun (uuid, ((), trustee_id)) () ->
+      let uuid_s = Uuidm.to_string uuid in
+      let w = SMap.find uuid_s !election_table in
+      let module W = (val w : WEB_ELECTION) in
+      lwt () =
+        match_lwt Web_persist.get_election_state uuid_s with
+        | `EncryptedTally _ -> return ()
+        | _ -> fail_http 404
+      in
+      T.tally_trustees w trustee_id () >>= Html5.send)
+
+let () =
+  Any.register
+    ~service:election_tally_trustees_post
+    (fun (uuid, ((), trustee_id)) partial_decryption ->
+      let uuid_s = Uuidm.to_string uuid in
+      lwt () =
+        match_lwt Web_persist.get_election_state uuid_s with
+        | `EncryptedTally _ -> return ()
+        | _ -> forbidden ()
+      in
+      lwt pds = Web_persist.get_partial_decryptions uuid_s in
+      lwt () =
+        if List.mem_assoc trustee_id pds then forbidden () else return ()
+      in
+      lwt () =
+        if trustee_id > 0 then return () else fail_http 404
+      in
+      let w = SMap.find uuid_s !election_table in
+      let module W = (val w : WEB_ELECTION) in
+      let pks = W.dir / string_of_election_file ESKeys in
+      let pks = Lwt_io.lines_of_file pks in
+      lwt () = Lwt_stream.njunk (trustee_id-1) pks in
+      lwt pk = Lwt_stream.peek pks in
+      lwt () = Lwt_stream.junk_while (fun _ -> true) pks in
+      lwt pk =
+        match pk with
+        | None -> fail_http 404
+        | Some x -> return x
+      in
+      let pk = trustee_public_key_of_string W.G.read pk in
+      let pk = pk.trustee_public_key in
+      let pd = partial_decryption_of_string W.G.read partial_decryption in
+      let et = W.dir / string_of_election_file ESETally in
+      lwt et = Lwt_io.chars_of_file et |> Lwt_stream.to_string in
+      let et = encrypted_tally_of_string W.G.read et in
+      if W.E.check_factor et pk pd then (
+        let pds = (trustee_id, partial_decryption) :: pds in
+        lwt () = Web_persist.set_partial_decryptions uuid_s pds in
+        T.generic_error_page
+          "Your partial decryption has been received and checked!" () >>=
+        Html5.send
+      ) else (
+        T.generic_error_page
+          "The partial decryption didn't pass validation!" () >>=
+        Html5.send
+      ))
+
 let content_type_of_file = function
   | ESRaw | ESKeys | ESBallots | ESETally -> "application/json"
   | ESCreds | ESRecords -> "text/plain"

src/web/web_templates.ml

@@ -939,6 +939,56 @@ let pretty_ballots w hashes () =
   lwt login_box = election_login_box w () in
   base ~title ~login_box ~content ()
 
+let tally_trustees w trustee_id () =
+  let module W = (val w : WEB_ELECTION) in
+  let params = W.election.e_params in
+  let title =
+    params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id
+  in
+  let content = [
+    p [pcdata "It is now time to compute your partial decryption factors."];
+    p [
+      pcdata "The hash of the encrypted tally is ";
+      b [span ~a:[a_id "hash"] []];
+      pcdata "."
+    ];
+    div ~a:[a_id "input_private_key"] [
+      p [pcdata "Please enter your private key:"];
+      input
+        ~a:[a_id "private_key"; a_size 80]
+        ~input_type:`Text
+        ();
+      button
+        ~a:[a_id "compute"]
+        ~button_type:`Button
+        [pcdata "Compute decryption factors"];
+    ];
+    div ~a:[a_id "pd_done"] [
+      post_form
+        ~service:election_tally_trustees_post
+        (fun pd ->
+          [
+            div [
+              textarea
+                ~a:[a_rows 5; a_cols 40; a_id "pd"]
+                ~name:pd
+                ();
+            ];
+            div [string_input ~input_type:`Submit ~value:"Submit" ()];
+          ]
+        ) (params.e_uuid, ((), trustee_id));
+    ];
+    div [
+      script ~a:[a_src (uri_of_string (fun () -> "../../../static/sjcl.js"))] (pcdata "");
+      script ~a:[a_src (uri_of_string (fun () -> "../../../static/jsbn.js"))] (pcdata "");
+      script ~a:[a_src (uri_of_string (fun () -> "../../../static/jsbn2.js"))] (pcdata "");
+      script ~a:[a_src (uri_of_string (fun () -> "../../../static/random.js"))] (pcdata "");
+      script ~a:[a_src (uri_of_string (fun () -> "../../../static/tool_js_pd.js"))] (pcdata "");
+    ]
+  ] in
+  let login_box = pcdata "" in
+  base ~title ~login_box ~content ()
+
 let login_box auth links =
   let module S = (val auth : AUTH_SERVICES) in
   let style =

src/web/web_templates.mli

@@ -43,6 +43,8 @@ val cast_confirmation : (module WEB_ELECTION) -> can_vote:bool -> string -> unit
 val cast_confirmed : (module WEB_ELECTION) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 val pretty_ballots : (module WEB_ELECTION) -> string list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 
+val tally_trustees : (module WEB_ELECTION) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
+
 val dummy :
   service:(unit, 'a, [< Eliom_service.post_service_kind ],
            [< Eliom_service.suff ], 'b,