(**************************************************************************)
(*                                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
open Lwt.Syntax
open Belenios
open Belenios_storage_api
open Belenios_server_core
open Web_common

module Make
    (X : Pages_sig.S)
    (Web_auth : Web_auth_sig.S)
    (Site_common : Site_common_sig.S) =
struct
  open X
  open Web_services
  open Site_common
  open Eliom_service
  open Eliom_registration

  let get_preferred_gettext () = Web_i18n.get_preferred_gettext "voter"

  let () =
    Redirection.register ~service:election_home_dir (fun uuid () ->
        return
          (Redirection (preapply ~service:election_home_redirect (uuid, ()))))

  let () =
    Any.register ~service:election_home_redirect (fun (uuid, ()) () ->
        let* () = Web_state.discard () in
        make_absolute_string_uri ~fragment:(Uuid.unwrap uuid) ~service:apps
          "election"
        |> String_redirection.send)

  let () =
    Any.register ~service:election_login_done (fun (uuid, state) () ->
        let fragment =
          Printf.sprintf "uuid=%s&state=%s" (Uuid.unwrap uuid) state
        in
        let page = make_absolute_string_uri ~fragment ~service:apps "vote" in
        String_redirection.send page)

  let send_confirmation_email s confirmation =
    let@ election =
      Public_archive.with_election s ~fallback:(fun () ->
          let uuid = Storage.E.get_uuid s in
          Lwt.fail (Election_not_found (uuid, "send_confirmation_email")))
    in
    let open (val election) in
    let title = template.t_name in
    let* metadata = Web_persist.get_election_metadata s in
    let* l = get_preferred_gettext () in
    let open (val l) in
    Lwt.catch
      (fun () ->
        let* r =
          Send_message.send
          @@ `Vote_confirmation
               {
                 lang = Language.unwrap lang;
                 uuid;
                 title;
                 confirmation;
                 contact = metadata.e_contact;
               }
        in
        match r with Ok _ -> Lwt.return_true | Error () -> Lwt.return_false)
      (fun _ -> Lwt.return_false)

  let () =
    Any.register ~service:election_cast_confirm (fun state () ->
        let@ env cont =
          let x = Web_auth.State.get_election ~state in
          match x with Some x -> cont x | None -> fail_http `Forbidden
        in
        let uuid = env.uuid in
        let@ s = Storage.E.with_transaction uuid in
        let@ election = with_election s in
        match env.state with
        | None -> Pages_voter.lost_ballot s election () >>= Html.send
        | Some { ballot; precast_data; _ } -> (
            match env.user with
            | None -> forbidden ()
            | Some user ->
                let* result =
                  Lwt.catch
                    (fun () ->
                      let* hash =
                        Api_elections.cast_ballot send_confirmation_email s
                          election ~ballot ~user ~precast_data
                      in
                      return (`Ok hash))
                    (function
                      | BeleniosWebError e -> return (`Error e)
                      | e -> Lwt.fail e)
                in
                let () = Web_auth.State.set_result ~state result in
                redir_preapply election_login_done (uuid, state) ()))
end
