mte/src/keys.ml

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

module type S = Keys_intf.S

module Make (Conn : Pg.CONN) = struct
  open Syntax
  open Crypto

  let master_pub = Config.Exchange.master_public_key
  let secmod_rsa_pub = Secmod_rsa.sm_key_pub
  let secmod_eddsa_pub = Secmod_eddsa.sm_key_pub

  let sign ~pub s =
    Secmod_eddsa.sign ~pub s |> function
    | Error e -> Fmt.failwith "sign failure: %s." e
    | Ok v -> v

  let sign_denom ~pub s =
    Secmod_rsa.sign ~pub s |> function
    | Error e -> Fmt.failwith "sign_denom failure: %s." e
    | Ok v -> v

  (* - *)
  let conn = (module Conn : Pg.CONN)
  let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti
  let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti

  let signkeys () : Signkey.t list result =
    let now = Timestamp.of_ptime @@ Ptime_clock.now () in
    Pg.get_active_signkeys conn ~now |> unwrap_err_caqti

  let denominations () = Pg.get_denominations conn () |> unwrap_err_caqti

  (* TODO check stamps definitions *)
  let make_future_sk ~pub ~start ~expire =
    let stamp_start = Timestamp.of_absolute start in
    let stamp_expire = Timestamp.of_absolute expire in
    let stamp_end = stamp_expire 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
      sign_f ~f:Secmod_eddsa.sign_with_sm_key
        { exchange_pub; anchor_time; duration }
    in
    Api.FutureSignKey.
      { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }

  let make_future_dn ~coin ~pub ~start =
    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
    in
    let stamp_start = Timestamp.of_absolute start in
    let stamp_expire_withdraw =
      Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
    in
    let stamp_expire_deposit =
      Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
    in
    let stamp_expire_legal =
      Timestamp.of_absolute @@ Time.Absolute.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 h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
    let denom_secmod_sig =
      let open Signatures.DenominationKeyAnnouncement in
      let h_denom_pub = h_pub in
      let h_section_name = Hash.Cstring.H64.hash section_name in
      let anchor_time = stamp_start in
      let duration_withdraw =
        Timestamp.diff stamp_start stamp_expire_withdraw
      in
      sign_f ~f:Secmod_rsa.sign_with_sm_key
        { h_denom_pub; h_section_name; anchor_time; duration_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 future_signkeys () =
    let+ l =
      list_map
        (fun (pub, t1, t2) ->
          let* opt = find_signkey pub in
          match opt with
          | None ->
              let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
              Ok (Some future_sk)
          | Some sk -> (
              match Timestamp.of_absolute t1 = sk.stamp_start with
              | false ->
                  Fmt.error
                    "secmod/database stamp_start mismatch for signkey `%s`"
                    (EddsaPublicKey.to_b32 pub)
              | true -> Ok None))
        (Secmod_eddsa.keys ())
    in
    List.filter_map Fun.id l

  let future_denominations () =
    let+ l =
      list_map
        (fun (section_name, pub, t1, _t2) ->
          let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
          (*?? let duration_withdraw = Time.Absolute.diff t1 t2 in*)
          let* opt = find_denomination h_pub in
          match opt with
          | None ->
              let* coin =
                Config.Coin.all_coins
                |> List.find_opt (fun coin ->
                    coin.Config.Coin.section_name = section_name)
                |> function
                | Some v -> Ok v
                | None ->
                    Fmt.error "coin `%s` not found in configuration"
                      section_name
              in
              let future_dn = make_future_dn ~coin ~pub ~start:t1 in
              Ok (Some future_dn)
          | Some sk -> (
              match Timestamp.of_absolute t1 = sk.stamp_start with
              | false ->
                  Fmt.error
                    "secmod/database stamp_start mismatch for denomination `%s`"
                    section_name
              | true -> Ok None))
        (Secmod_rsa.keys ())
    in
    List.filter_map Fun.id l

  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;
        revoked_sig= None;
      }

  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;
        revoked_sig= None;
      }

  let certify_future_signkey pub master_sig =
    Secmod_eddsa.keys () |> List.find_opt (fun (pub', _t1, _t2) -> pub' = pub)
    |> function
    | None -> Error "future signkey not found"
    | Some (pub, t1, t2) ->
        let* () =
          let* opt = find_signkey pub in
          match opt with
          | None -> Ok ()
          | Some _sk -> Error "signkey already certified"
        in
        (* rebuild it *)
        let future_sk = make_future_sk ~pub ~start:t1 ~expire:t2 in
        let sk = sk_of_future_sk future_sk master_sig in
        let* () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
        Ok ()

  let certify_future_denomination h_pub master_sig =
    Secmod_rsa.keys ()
    |> List.find_opt (fun (_section_name, pub, _t1, _t2) ->
        let h_pub' = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
        h_pub' = h_pub)
    |> function
    | None -> Error "future denomination not found"
    | Some (section_name, pub, t1, _t2) ->
        let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
        let* () =
          let* opt = find_denomination h_pub in
          match opt with
          | None -> Ok ()
          | Some _sk -> Error "denomination already certified"
        in
        (* rebuild it *)
        let* coin =
          Config.Coin.all_coins
          |> List.find_opt (fun coin ->
              coin.Config.Coin.section_name = section_name)
          |> function
          | Some v -> Ok v
          | None ->
              Fmt.error "coin `%s` not found in configuration" section_name
        in
        let future_dn = make_future_dn ~coin ~pub ~start:t1 in
        let dn = dn_of_future_dn future_dn h_pub master_sig in
        let* () = Pg.insert_denom conn dn |> unwrap_err_caqti in
        Ok ()

  let revoke_signkey pub revoked_sig =
    let* opt = find_signkey pub in
    match opt with
    | None -> Error "signkey not found"
    | Some _sk ->
        let* () = Secmod_eddsa.revoke_key pub in
        let+ () =
          Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
        in
        ()

  let revoke_denomination h_pub revoked_sig =
    let* opt = find_denomination h_pub in
    match opt with
    | None -> Error "denomination not found"
    | Some sk ->
        let pub = sk.pub in
        let* () = Secmod_rsa.revoke_key pub in
        let+ () =
          Pg.insert_denomination_revocation conn h_pub revoked_sig
          |> unwrap_err_caqti
        in
        ()
end