tool_js_pd.ml 4.65 KB
Newer Older
1 2 3
(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
Stephane Glondu's avatar
Stephane Glondu committed
4
(*  Copyright © 2012-2018 Inria                                           *)
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
(*                                                                        *)
(*  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
24
open Common
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
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

44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
let basic_check_private_key s =
  let n = String.length s in
  let rec leading i =
    if i < n then
      match s.[i] with
      | '"' -> middle (i+1)
      | _ -> failwith "Must start with a double quote"
    else failwith "Too short"
  and middle i =
    if i < n then
      match s.[i] with
      | '0'..'9' -> ending (i+1)
      | _ -> failwith "Must have at least one digit"
    else failwith "Too short"
  and ending i =
    if i < n then
      match s.[i] with
      | '0'..'9' -> ending (i+1)
      | '"' -> (if i+1 < n then failwith "Must end with a double quote")
      | c -> Printf.ksprintf failwith "Illegal character: %c" c
    else failwith "Must end with a double quote"
  in leading 0

67 68
let compute_partial_decryption _ =
  Js.Opt.option !election >>= fun e ->
69
  let election = Election.(get_group (of_string e)) in
70
  let module P = (val election) in
71
  let module E = Election.Make (P) (DirectRandom) in
72 73 74 75 76 77
  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 =
78 79 80 81 82 83 84 85 86 87 88 89 90 91
    try
      let epk = get_textarea "encrypted_private_key" in
      let module PKI = Trustees.MakePKI (P.G) (DirectRandom) in
      let module C = Trustees.MakeChannels (P.G) (DirectRandom) (PKI) in
      let sk = PKI.derive_sk pk_str and dk = PKI.derive_dk pk_str in
      let vk = P.G.(g **~ sk) in
      let epk = C.recv dk vk epk in
      (partial_decryption_key_of_string epk).pdk_decryption_key
    with Not_found ->
      basic_check_private_key pk_str;
      try number_of_string pk_str
      with e ->
        Printf.ksprintf
          failwith "Error in format of private key: %s" (Printexc.to_string e)
92
  in
93
  let factor = E.compute_factor encrypted_tally private_key in
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
  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