open Syntax
open Crypto

type 'a result = ('a, string) Result.t

module type S = sig
  val sign : eddsa_pub -> string -> eddsa_sig
  val sign_denom : denom_hash -> string -> rsa_sig
  val find_signkey : eddsa_pub -> Signkey.t option result
  val find_denomination : denom_hash -> Denomination.t option result
  val signkeys : unit -> Signkey.t list result
  val denominations : unit -> Denomination.t list result
  val denominations_last_change : unit -> Timestamp.t

  (* future keys *)
  val make_future_keys_response : unit -> Api.FutureKeysResponse.t result
  val verify_future_signkey : Api.SignKeySignature.t -> unit result
  val verify_future_denomination : Api.DenomSignature.t -> unit result
  val certify_future_signkey : Api.SignKeySignature.t -> unit result
  val certify_future_denomination : Api.DenomSignature.t -> unit result

  val revoke_signkey :
    eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result

  val revoke_denomination :
    denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result
end

module Make (Conn : Pg.CONN) (Fs : Fat.FS) : S = struct
  module Sm_eddsa = Secmod_eddsa.Make (Fs)
  module Sm_rsa = Secmod_rsa.Make (Fs)

  let conn = (module Conn : Pg.CONN)

  (* TODO better error
     can only be "key not found", either:
       - we tried to sign with a key that is not ours
       - key was revoked
       - bad keyring state *)
  let sign pub s =
    match Sm_eddsa.sign pub s with
    | Error e -> Fmt.failwith "sign failure: %s." e
    | Ok v -> v

  let sign_denom h_pub s =
    match Sm_rsa.sign h_pub s with
    | Error e -> Fmt.failwith "sign_denom failure: %s." e
    | Ok v -> v

  (* - *)
  let find_signkey pub = Pg.find_signkey conn pub |> unwrap_caqti
  let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_caqti

  let warn_key_state =
    let first = ref true in
    fun () ->
      if !first then (
        Logs.warn (fun m ->
            m
              "some keys found in database are missing from secmod, (unclean \
               database/secmod state?)");
        first := false;
        ())

  let signkeys () : Signkey.t list result =
    let now = Timestamp.of_ptime @@ Mirage_ptime.now () in
    let+ l = Pg.get_signkeys conn ~now |> unwrap_caqti in
    let missing_l, l =
      List.partition
        (fun sk -> Option.is_none @@ Sm_eddsa.find_key sk.Signkey.pub)
        l
    in
    match missing_l with
    | [] -> l
    | _ ->
        warn_key_state ();
        Logs.debug (fun m -> m "found %d active signkey(s)" (List.length l));
        l

  let denominations () =
    let+ l = Pg.get_denominations conn () |> unwrap_caqti in
    let missing_l, l =
      List.partition
        (fun dn -> Option.is_none @@ Sm_rsa.find_key dn.Denomination.h_pub)
        l
    in
    match missing_l with
    | [] -> l
    | _ ->
        warn_key_state ();
        Logs.debug (fun m ->
            m "found %d active denomination(s)" (List.length l));
        l

  let denominations_last_change () = Sm_rsa.last_change ()

  let make_future_sk (pub, (start, expire)) =
    Logs.debug (fun m -> m "make_future_sk: `%s`" (EddsaPublicKey.to_b32 pub));
    let open Time in
    let stamp_start = Timestamp.of_absolute start in
    let stamp_expire = Timestamp.of_absolute expire in
    let stamp_end =
      Timestamp.of_absolute
      @@ TimeAbsolute.add start Config.Exchange.signkey_legal_duration
    in
    let signkey_secmod_sig =
      let open Signatures.SigningKeyAnnouncement in
      let exchange_pub = pub in
      let anchor_time = stamp_start in
      let duration = Timestamp.diff stamp_start stamp_expire in
      signf Sm_eddsa.sign_secmod { exchange_pub; anchor_time; duration }
    in
    Api.FutureSignKey.
      { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }

  let coin_of_section_name section_name =
    Config.Coin.all_coins
    |> List.find_opt (fun coin -> coin.Config.Coin.section_name = section_name)
    |> function
    | None ->
        Fmt.failwith "coin section `%s` not found in configuration" section_name
    | Some v -> v

  let make_future_dn (h_pub, (section_name, pub, start)) =
    Logs.debug (fun m ->
        m "make_future_dn: `%s`" (DenominationHash.to_b32 h_pub));
    let open Time in
    let Config.Coin.
          {
            section_name;
            value;
            duration_withdraw;
            duration_spend;
            duration_legal;
            fee_withdraw;
            fee_deposit;
            fee_refresh;
            fee_refund;
            cipher= _;
            rsa_keysize= _;
            age_restricted= _;
          } =
      coin_of_section_name section_name
    in
    let stamp_start = Timestamp.of_absolute start in
    let stamp_expire_withdraw =
      Timestamp.of_absolute @@ TimeAbsolute.add start duration_withdraw
    in
    let stamp_expire_deposit =
      Timestamp.of_absolute @@ TimeAbsolute.add start duration_spend
    in
    let stamp_expire_legal =
      Timestamp.of_absolute @@ TimeAbsolute.add start duration_legal
    in
    let open Api in
    let rsa_denomination_key =
      RsaDenominationKey.{ age_mask= 0; rsa_pub= pub }
    in
    let denom_pub = DenominationKey.Rsa rsa_denomination_key in
    let denom_secmod_sig =
      let open Signatures.DenominationKeyAnnouncement in
      signf Sm_rsa.sign_secmod
        {
          h_denom_pub= h_pub;
          h_section_name= Hash.Cstring.H64.hash section_name;
          anchor_time= stamp_start;
          duration_withdraw= Timestamp.diff stamp_start stamp_expire_withdraw;
        }
    in
    FutureDenom.
      {
        section_name;
        value;
        stamp_start;
        stamp_expire_withdraw;
        stamp_expire_deposit;
        stamp_expire_legal;
        denom_pub;
        fee_withdraw;
        fee_deposit;
        fee_refresh;
        fee_refund;
        denom_secmod_sig;
      }

  let find_future_signkey pub =
    match Sm_eddsa.find_key pub with
    | None -> Error "future signkey not found"
    | Some (pub, (t1, t2)) ->
        let fsk = make_future_sk (pub, (t1, t2)) in
        Ok fsk

  let find_future_denomination h_pub =
    match Sm_rsa.find_key h_pub with
    | None -> Error "future denomination not found"
    | Some (h_pub, (section_name, pub, t1)) ->
        let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in
        Ok future_dn

  let make_future_keys_response () =
    let now = Timestamp.of_ptime @@ Mirage_ptime.now () in
    (* get keys from database to filter out keys already certified *)
    let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_caqti in
    let sk_ht = Hashtbl.create 0xff in
    List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l;
    let future_signkeys =
      Sm_eddsa.keys ()
      |> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub)
      |> List.map make_future_sk
    in
    let* dn_db_l = Pg.get_denominations conn () |> unwrap_caqti in
    let dn_ht = Hashtbl.create 0xff in
    List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l;
    let future_denoms =
      Sm_rsa.keys ()
      |> List.filter (fun (h_pub, _) -> not @@ Hashtbl.mem dn_ht h_pub)
      |> List.map make_future_dn
    in
    Logs.info (fun m ->
        m "%d future signkey(s) and %d future denomination(s) to certify"
          (List.length future_signkeys)
          (List.length future_denoms));
    Ok
      Api.FutureKeysResponse.
        {
          future_denoms;
          future_signkeys;
          master_pub= Config.Exchange.master_public_key;
          denom_secmod_public_key= Sm_rsa.sm_pub;
          signkey_secmod_public_key= Sm_eddsa.sm_pub;
        }

  let sk_of_future_sk future_sk master_sig =
    let Api.FutureSignKey.
          { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
      future_sk
    in
    Signkey.{ pub= key; stamp_start; stamp_expire; stamp_end; master_sig }

  let dn_of_future_dn future_dn h_pub master_sig =
    let Api.FutureDenom.
          {
            section_name= _;
            value;
            stamp_start;
            stamp_expire_withdraw;
            stamp_expire_deposit;
            stamp_expire_legal;
            denom_pub;
            fee_withdraw;
            fee_deposit;
            fee_refresh;
            fee_refund;
            denom_secmod_sig= _;
          } =
      future_dn
    in
    let rsa_pub =
      match denom_pub with
      | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
    in
    Denomination.
      {
        pub= rsa_pub;
        value;
        stamp_start;
        stamp_expire_withdraw;
        stamp_expire_deposit;
        stamp_expire_legal;
        fee_withdraw;
        fee_deposit;
        fee_refresh;
        fee_refund;
        age_mask= 0;
        h_pub;
        master_sig;
      }

  let verify_future_signkey Api.SignKeySignature.{ key; master_sig } =
    let* fsk = find_future_signkey key in
    let sk = sk_of_future_sk fsk master_sig in
    Signkey.verify_exchange_signing_key_validity ~key:Config.master_public_key
      sk

  let verify_future_denomination Api.DenomSignature.{ h_denom_pub; master_sig }
      =
    let* fdn = find_future_denomination h_denom_pub in
    let dn = dn_of_future_dn fdn h_denom_pub master_sig in
    Denomination.verify_denomination_key_validity ~key:Config.master_public_key
      dn

  let certify_future_signkey Api.SignKeySignature.{ key= pub; master_sig } =
    match Sm_eddsa.find_key pub with
    | None -> Error "future signkey not found"
    | Some (pub, (t1, t2)) -> (
        let* opt = find_signkey pub in
        match opt with
        | Some _sk ->
            Logs.info (fun m -> m "signkey already certified");
            Ok ()
        | None ->
            (* rebuild it *)
            let future_sk = make_future_sk (pub, (t1, t2)) in
            let sk = sk_of_future_sk future_sk master_sig in
            let+ () = Pg.insert_signkey conn sk |> unwrap_caqti in
            Logs.info (fun m ->
                m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub));
            ())

  let certify_future_denomination
      Api.DenomSignature.{ h_denom_pub= h_pub; master_sig } =
    match Sm_rsa.find_key h_pub with
    | None -> Error "future denomination not found"
    | Some (h_pub, (section_name, pub, t1)) -> (
        let* opt = find_denomination h_pub in
        match opt with
        | Some _dn ->
            Logs.info (fun m -> m "denomination already certified");
            Ok ()
        | None ->
            let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in
            let dn = dn_of_future_dn future_dn h_pub master_sig in
            let+ () = Pg.insert_denom conn dn |> unwrap_caqti in
            Logs.info (fun m ->
                m "certified denomination `%s`"
                  (DenominationHash.to_b32 dn.h_pub));
            ())

  let revoke_signkey pub revoked_sig =
    let* opt = find_signkey pub in
    let* _sk = Option.to_result ~none:"signkey not found" opt in
    let* () = Sm_eddsa.revoke pub in
    let+ () =
      Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_caqti
    in
    Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub));
    ()

  let revoke_denomination h_pub revoked_sig =
    let* opt = find_denomination h_pub in
    let* dn = Option.to_result ~none:"denomination not found" opt in
    let* () = Sm_rsa.revoke dn.h_pub in
    let+ () =
      Pg.insert_denomination_revocation conn dn.h_pub revoked_sig
      |> unwrap_caqti
    in
    Logs.info (fun m ->
        m "revoked denomination `%s`" (DenominationHash.to_b32 h_pub));
    ()
end