open Syntax
open Crypto
open Mirage_crypto_ec
open Config.Exchange_secmod_eddsa
open Time

type priv = Ed25519.priv
type pub = Ed25519.pub

type key = {
  priv: priv;
  pub: pub;
  t1: Absolute.t;
  t2: Absolute.t;
}

type t = {
  sm_key_priv: priv;
  sm_key_pub: pub;
  keys: key list;
}

let time_abs_of_string s =
  match int_of_string_opt s with
  | None -> None
  | Some n ->
      let ts = Absolute.of_s (Int64.of_int n) in
      Some ts

let time_abs_to_string abs =
  abs
  |> Timestamp.of_absolute
  |> Timestamp.to_s
  |> Option.get
  |> Int64.to_int
  |> string_of_int

let read_key fname =
  let fpath = Fpath.(v key_dir / fname) in
  let* data = Bos.OS.File.read fpath |> unwrap_err_msg in
  EddsaPrivateKey.of_octets data

let write_eddsa fname priv =
  let fpath = Fpath.(v key_dir / fname) in
  let data = EddsaPrivateKey.to_octets priv in
  Bos.OS.File.write fpath data |> unwrap_err_msg

let write_key t =
  let t1 = time_abs_to_string t.t1 in
  let t2 = time_abs_to_string t.t2 in
  let fname = Fmt.str "%s-%s" t1 t2 in
  write_eddsa fname t.priv

let split_in_periodes ~start ~end_ =
  (* no overlap on first periode
     this is to not generate a key valid in the past *)
  let t1 = start in
  let t2 = Absolute.add start duration in
  let acc = [ (t1, t2) ] in
  let start = t2 in
  let rec go acc start end_ =
    let t1 = Absolute.sub start overlap_duration in
    let t2 = Absolute.add start duration in
    if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
  in
  go acc start end_

let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l

let gen_additional_keys_until_lookahead ~now l =
  let l = sort_keys l in
  let start =
    let l_rev = List.rev l in
    match l_rev with
    | [] -> now
    | hd :: _ -> Absolute.sub hd.t2 overlap_duration
  in
  let end_ = Absolute.add now lookahead_sign in
  let periodes = split_in_periodes ~start ~end_ in
  let new_keys =
    List.map
      (fun (t1, t2) ->
        let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
        { priv; pub; t1; t2 })
      periodes
  in
  new_keys

let check_periodes _l =
  (* TODO *)
  Ok ()

let purge _t =
  (* TODO *)
  Ok ()

let purge_outdated ~now l =
  let+ l =
    list_map
      (fun t ->
        if Absolute.compare now t.t2 >= 0 then
          let* () = purge t in
          Ok None
        else Ok (Some t))
      l
  in
  List.filter_map Fun.id l

let load_key fpath =
  let fname = Fpath.filename fpath in
  if fname = sm_priv_key then Ok None
  else
    match String.split_on_char '-' fname with
    | [] -> Fmt.failwith "not possible"
    | [ t1; t2 ] -> (
        match (time_abs_of_string t1, time_abs_of_string t2) with
        | None, _ | _, None -> Fmt.error "invalid filename `%s`" fname
        | Some t1, Some t2 ->
            let* priv = read_key fname in
            let pub = EddsaPrivateKey.pub_of_priv priv in
            Ok (Some { priv; pub; t1; t2 }))
    | _ -> Ok None

let load () =
  let dir = Fpath.v key_dir in
  let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
  if b then
    Logs.info (fun m -> m "secmod_eddsa: created directory `%a`" Fpath.pp dir);
  let* l =
    Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg
  in
  let* l = list_map load_key l in
  let keys = List.filter_map Fun.id l in
  match keys with
  | [] -> Ok None
  | _l ->
      let* sm_key_priv = read_key sm_priv_key in
      let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
      Ok (Some { sm_key_priv; sm_key_pub; keys })

let init () =
  let* opt = load () in
  let* t =
    match opt with
    | Some t -> Ok t
    | None ->
        let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
        let* () = write_eddsa sm_priv_key sm_key_priv in
        Ok { sm_key_priv; sm_key_pub; keys= [] }
  in
  let now = Absolute.of_ptime (Ptime_clock.now ()) in
  let* keys = purge_outdated ~now t.keys in
  let* () = check_periodes keys in
  let new_keys = gen_additional_keys_until_lookahead ~now keys in
  let* () = list_iter write_key new_keys in
  let keys = keys @ new_keys in
  let keys = sort_keys keys in
  let t = { t with keys } in
  Ok t

let t =
  match init () with
  | Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
  | Ok t -> t

(*
  - sign
  - expose future_sk list
  - purge
  - revoke
  - schedule tasks
  - !lock

  todo taler doc/config is confusing
  how is computed stamp_expire stamp_end
  what to do of 'Exchange.signkey_legal_duration'
  => (??)
    stamp_expire = stamp_start + duration
    stamp_end = stamp_start + signkey_legal_duration
*)