(**************************************************************************)
(*                                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 Js_of_ocaml_tyxml
open Belenios
open Belenios_web_api
open Tyxml_js.Html5
open Belenios_js.Common
open Belenios_js.Session
open Common

type input_kind = { of_float : float -> string; to_float : string -> float }

let date_kind =
  {
    of_float =
      (fun x ->
        Js.to_string
          (new%js Js.date_fromTimeValue (Js.float (x *. 1000.)))##toISOString);
    to_float = (fun x -> Js.to_float (Js.date##parse (Js.string x)) /. 1000.);
  }

let period_kind =
  { of_float = int_of_float >> string_of_int; to_float = float_of_string }

let rec show main uuid =
  let@ () = show_in main in
  let* x = Api.(get (election uuid) `Nobody) in
  let@ raw_election, _ = with_ok "election" x in
  let* x = Api.(get (election_status uuid) `Nobody) in
  let ifmatch = get_ifmatch x in
  let@ status, _ = with_ok "status" x in
  let make label request =
    let@ () = button label in
    let* x = Api.(post ?ifmatch (election_status uuid) !user request) in
    let@ () = show_in main in
    generic_proceed x (fun () -> show main uuid)
  in
  let button_delete =
    let@ () = button "Delete election" in
    if confirm "Are you sure?" then (
      let* x = Api.(delete (election_status uuid) !user) in
      let@ () = show_in main in
      let@ () = generic_proceed x in
      Dom_html.window##.location##.hash := Js.string "";
      Lwt.return_unit)
    else Lwt.return_unit
  in
  let buttons =
    [
      make "Open election" `Open;
      make "Close election" `Close;
      make "Compute encrypted tally" `ComputeEncryptedTally;
      make "Finish shuffling" `FinishShuffling;
      make "Release tally" `ReleaseTally;
      make "Archive election" `Archive;
      button_delete;
    ]
  in
  let get_date k (_, get) =
    let y = get () in
    if y = "" then None else Some (k.to_float y)
  in
  let* auto_dates =
    let* x = Api.(get (election_auto_dates uuid) `Nobody) in
    let@ dates, ifmatch = with_ok "automatic-dates" x in
    let make_input k d =
      let value = Option.map k.of_float d in
      input ?value `Text
    in
    let auto_open = make_input date_kind dates.auto_date_open in
    let auto_close = make_input date_kind dates.auto_date_close in
    let auto_publish = make_input date_kind dates.auto_date_publish in
    let auto_grace = make_input period_kind dates.auto_date_grace_period in
    let set_button =
      let@ () = button "Set automatic dates" in
      let dates =
        {
          auto_date_open = get_date date_kind auto_open;
          auto_date_close = get_date date_kind auto_close;
          auto_date_publish = get_date date_kind auto_publish;
          auto_date_grace_period = get_date period_kind auto_grace;
        }
      in
      let* x = Api.(put ~ifmatch (election_auto_dates uuid) !user dates) in
      let@ () = show_in main in
      generic_proceed x (fun () -> show main uuid)
    in
    Lwt.return
      [
        fst auto_open;
        fst auto_close;
        fst auto_grace;
        fst auto_publish;
        set_button;
      ]
  in
  let make what e =
    let* x = Api.get e !user in
    let@ voters, _ = with_ok what x in
    let t, _ = textarea (e.to_string voters) in
    Lwt.return [ t ]
  in
  let* voters = make "voters" (Api.election_voters uuid) in
  let* records = make "records" (Api.election_records uuid) in
  let* pds =
    make "partial-decryptions" (Api.election_partial_decryptions uuid)
  in
  let* shuffles = make "shuffles" (Api.election_shuffles uuid) in
  let shuffle =
    let i, iget = input `Text in
    let make label request =
      let@ () = button label in
      let* x = Api.(post (election_shuffle uuid (iget ())) !user request) in
      let@ () = show_in main in
      generic_proceed x (fun () -> show main uuid)
    in
    [ i; make "Skip" `Skip; make "Select" `Select ]
  in
  Lwt.return
    [
      div [ a ~href:"#" "Home" ];
      h1 [ txt "Raw election" ];
      div [ txt raw_election ];
      h1 [ txt "Status" ];
      div [ txt @@ string_of_election_status status ];
      h1 [ txt "Actions" ];
      div buttons;
      div auto_dates;
      h1 [ txt "Voters" ];
      div voters;
      h1 [ txt "Records" ];
      div records;
      h1 [ txt "Shuffles" ];
      div shuffles;
      div shuffle;
      h1 [ txt "Partial decryptions" ];
      div pds;
    ]
