(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
(*  Copyright © 2012-2022 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 Lwt.Syntax
open Js_of_ocaml
open Belenios_core
open Common
open Belenios
open Serializable_j
open Signatures
open Belenios_js.Common
open Belenios_api.Serializable_j

let set_step i =
  let open (val !Belenios_js.I18n.gettext) in
  let$ e = document##getElementById (Js.string "current_step") in
  clear_content e;
  let t = Printf.sprintf (f_ "Step %d/3") i in
  let t = document##createTextNode (Js.string t) in
  Dom.appendChild e t

let set_explain str =
  let$ e = document##getElementById (Js.string "explain") in
  clear_content e;
  let t = document##createTextNode (Js.string str) in
  Dom.appendChild e t;
  Dom.appendChild e (Dom_html.createBr document)

let gen_cert draft e _ =
  let version = draft.draft_version in
  let group = draft.draft_group in
  let module G = (val Group.of_string ~version group : GROUP) in
  let module Trustees = (val Trustees.get_by_version version) in
  let module P = Trustees.MakePKI (G) (Random) in
  let module C = Trustees.MakeChannels (G) (Random) (P) in
  let module T = Trustees.MakePedersen (G) (Random) (P) (C) in
  Lwt.async (fun () ->
      let key, cert = T.step1 () in
      clear_content e;
      set_download "private_key" "text/plain" "private_key.txt" key;
      set_element_display "key_helper" "block";
      let fp = sha256_b64 cert.s_message in
      let cert = string_of_cert cert in
      set_content "pki_fp" fp;
      set_textarea "data" cert;
      Lwt.return_unit);
  Js._false

let proceed draft pedersen =
  let version = draft.draft_version in
  let group = draft.draft_group in
  let$ e = document##getElementById (Js.string "compute_private_key") in
  let$ e = Dom_html.CoerceTo.input e in
  let key = Js.to_string e##.value in
  let certs = { certs = pedersen.pedersen_certs } in
  let threshold = pedersen.pedersen_threshold in
  let module G = (val Group.of_string ~version group : GROUP) in
  let module Trustees = (val Trustees.get_by_version version) in
  let module P = Trustees.MakePKI (G) (Random) in
  let module C = Trustees.MakeChannels (G) (Random) (P) in
  let module T = Trustees.MakePedersen (G) (Random) (P) (C) in
  Lwt.async (fun () ->
      match pedersen.pedersen_step with
      | 3 ->
          let polynomial = T.step3 certs key threshold in
          set_textarea "compute_data" (string_of_polynomial polynomial);
          Lwt.return_unit
      | 5 ->
          let@ vinput cont =
            match pedersen.pedersen_vinput with
            | Some x -> cont x
            | None ->
                alert "Unexpected state! (missing vinput)";
                Lwt.return_unit
          in
          let voutput = T.step5 certs key vinput in
          set_textarea "compute_data"
            (string_of_voutput (swrite G.to_string) voutput);
          Lwt.return_unit
      | _ ->
          alert "Unexpected state!";
          Lwt.return_unit)

let fail msg =
  set_content "election_url" msg;
  Lwt.return_unit

let fill_interactivity () =
  let open (val !Belenios_js.I18n.gettext) in
  let&&* e = document##getElementById (Js.string "interactivity") in
  let@ uuid, token =
   fun cont ->
    let hash = Dom_html.window##.location##.hash |> Js.to_string in
    match extract_uuid_and_token hash with
    | Some (uuid, token) -> cont (uuid, token)
    | None -> fail "(uuid error)"
  in
  let@ () = redirect_if_admin "threshold-trustee" uuid token in
  set_form_target "data_form" "submit-threshold-trustee" uuid token;
  set_form_target "data_form_compute" "submit-threshold-trustee" uuid token;
  let href = Dom_html.window##.location##.href |> Js.to_string in
  set_content "election_url" (build_election_url href uuid);
  let@ draft cont =
    let url = Printf.sprintf "../api/drafts/%s" uuid in
    let* x = get draft_of_string url in
    match x with Some x -> cont x | None -> fail "(token error)"
  in
  let@ pedersen cont =
    let url = Printf.sprintf "../api/drafts/%s/trustees-pedersen" uuid in
    let* x = get ~token (pedersen_of_string Yojson.Safe.read_json) url in
    match x with Some x -> cont x | None -> fail "(pedersen error)"
  in
  let step = pedersen.pedersen_step in
  let@ () =
   fun cont ->
    cont ();
    Lwt.return_unit
  in
  match step with
  | 0 ->
      set_element_display "data_form" "none";
      let t =
        document##createTextNode
          (Js.string
             (s_
                "Waiting for the election administrator to set the \
                 threshold... Reload the page to check progress."))
      in
      Dom.appendChild e t
  | 2 | 4 ->
      set_step (step / 2);
      set_element_display "data_form" "none";
      let t =
        document##createTextNode
          (Js.string
             (s_
                "Waiting for the other trustees... Reload the page to check \
                 progress."))
      in
      Dom.appendChild e t
  | 6 | 7 ->
      set_step 3;
      set_element_display "data_form" "none";
      let@ voutput cont =
        match pedersen.pedersen_voutput with
        | Some x -> cont x
        | None -> alert "Unexpected state! (missing voutput)"
      in
      let pk = Yojson.Safe.to_string voutput.vo_public_key.trustee_public_key in
      let fp = sha256_b64 pk in
      let msg =
        Printf.sprintf
          (f_
             "Your job in the key establishment protocol is done! The \
              fingerprint of your verification key is %s. Check that it is \
              published by the server when the election is open. Your private \
              key will be needed to decrypt the election result.")
          fp
      in
      let t = document##createTextNode (Js.string msg) in
      Dom.appendChild e t;
      set_element_display "div_instructions" "block"
  | 1 ->
      set_step 1;
      let b = Dom_html.createButton document in
      let t =
        document##createTextNode (Js.string (s_ "Generate private key"))
      in
      b##.onclick := Dom_html.handler (gen_cert draft e);
      Dom.appendChild b t;
      Dom.appendChild e b
  | 3 | 5 ->
      let explain =
        match step with
        | 3 ->
            s_
              "Now, all the certificates of the trustees have been generated. \
               Proceed to generate your share of the decryption key."
        | 5 ->
            s_
              "Now, all the trustees have generated their secret shares. \
               Proceed to the final checks so that the election can be \
               validated."
        | _ -> failwith "impossible step"
      in
      set_step ((step + 1) / 2);
      set_explain explain;
      set_element_display "compute_form" "block";
      let$ e = document##getElementById (Js.string "compute_button") in
      e##.onclick :=
        Dom_html.handler (fun _ ->
            proceed draft pedersen;
            Js._false)
  | _ -> alert "Unexpected state!"

let () =
  Lwt.async (fun () ->
      let* _ = Js_of_ocaml_lwt.Lwt_js_events.onload () in
      let* () = Belenios_js.I18n.auto_init "admin" in
      fill_interactivity ())
