mte/src/secmod_denom.ml

(* TODO
   have something better to represent initialization state
   (missing master_sig for fresh denom) *)
open Syntax

type eddsa_priv = Crypto.EddsaPrivateKey.t
type eddsa_pub = Crypto.EddsaPublicKey.t
type h_denom_pub = Bin_type.DenominationHash.t

type t = {
  lock: Miou.Mutex.t;
  sm_key_priv: eddsa_priv;
  sm_key_pub: eddsa_pub;
  denom_ht: (h_denom_pub, Denomination.t) Hashtbl.t;
  revoked_ht:
    ( h_denom_pub,
      Denomination.t * Bin_sig.MasterDenominationKeyRevocation.t )
    Hashtbl.t;
}

let get_sm_key_pub t = t.sm_key_pub
let get_sm_key_priv t = t.sm_key_priv

let get_denoms t =
  Miou.Mutex.protect t.lock @@ fun () ->
  Hashtbl.to_seq_values t.denom_ht |> List.of_seq

let add_master_signatures conn t l =
  Miou.Mutex.protect t.lock @@ fun () ->
  list_iter
    (fun (h_denom_pub, master_sig) ->
      match Hashtbl.find_opt t.denom_ht h_denom_pub with
      | None -> Error "secmod_denom failure: denomination hash not found."
      | Some denom ->
          let denom = { denom with master_sig= Some master_sig } in
          let* () =
            Pg.add_denomination_key conn ~master_sig denom |> unwrap_err_caqti
          in
          Hashtbl.replace t.denom_ht h_denom_pub denom;
          Ok ())
    l

let revoke_denomination t h_denom_pub master_sig =
  Miou.Mutex.protect t.lock @@ fun () ->
  match Hashtbl.find_opt t.denom_ht h_denom_pub with
  | None -> Error "secmod_denom failure: denomination hash not found."
  | Some denom ->
      Hashtbl.remove t.denom_ht h_denom_pub;
      Hashtbl.replace t.revoked_ht h_denom_pub (denom, master_sig);
      Ok ()

let dir = Fpath.(v "data" / "secmod_signkey")

(* TODO secmod store *)
let _store_secmod_data t =
  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key_priv in
  get_denoms t
  |> List.mapi (fun i key ->
      let fname = Fpath.(dir / string_of_int i) in
      (fname, key.Denomination.priv))
  |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)

let db_lookup_denom_data conn ~section_name priv =
  let pub = Crypto.RsaPrivateKey.pub_of_priv priv in
  let h_pub =
    Bin_type.DenominationHash.hash (Crypto.RsaPublicKey.to_octets pub)
  in
  let* opt = Pg.lookup_denomination_key conn h_pub in
  match opt with
  | None ->
      Fmt.error_msg
        "load_denom error no associated metadata found in database for \
         denomination `%s`."
        section_name
  | Some
      ( stamp_start,
        stamp_expire_withdraw,
        stamp_expire_deposit,
        stamp_expire_legal,
        value,
        fee_withdraw,
        fee_deposit,
        fee_refresh,
        fee_refund,
        age_mask ) ->
      let master_sig = None in
      let v =
        Denomination.
          {
            pub;
            priv;
            section_name;
            value;
            stamp_start;
            stamp_expire_withdraw;
            stamp_expire_deposit;
            stamp_expire_legal;
            fee_withdraw;
            fee_deposit;
            fee_refresh;
            fee_refund;
            age_mask;
            h_pub;
            master_sig;
          }
      in
      Ok v

let load conn =
  let error_invalid_state =
    Fmt.error_msg "secmod_denom load error: invalid store state."
  in
  let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sm_key") in
  let* denoms =
    let* l =
      let open Config.Coin in
      list_map
        (fun coin ->
          let section_name = coin.section_name in
          let fname = Fpath.(dir / section_name) in
          let* opt = Data_file.read_rsa fname in
          match opt with
          | None -> Ok None
          | Some priv ->
              (* todo: could check that coin config match db values *)
              let* denom_data = db_lookup_denom_data conn ~section_name priv in
              Ok (Some denom_data))
        all_coins
    in
    match Syntax.opt_list l with
    | Error () -> error_invalid_state
    | Ok opt -> Ok opt
  in
  match (sm_key_priv, denoms) with
  | None, None -> Ok None
  | Some sm_key_priv, Some denoms ->
      let sm_key_pub = Crypto.EddsaPrivateKey.pub_of_priv sm_key_priv in
      let lock = Miou.Mutex.create () in
      let denom_ht =
        denoms
        |> List.map (fun v -> (v.Denomination.h_pub, v))
        |> List.to_seq
        |> Hashtbl.of_seq
      in
      let revoked_ht = Hashtbl.create 0xff in
      Ok (Some { lock; sm_key_priv; sm_key_pub; denom_ht; revoked_ht })
  | _, _ -> error_invalid_state

let make_new () =
  let lock = Miou.Mutex.create () in
  let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
  let denoms = List.map Denomination.make Config.Coin.all_coins in
  let denom_ht =
    denoms
    |> List.map (fun v -> (v.Denomination.h_pub, v))
    |> List.to_seq
    |> Hashtbl.of_seq
  in
  let revoked_ht = Hashtbl.create 0xff in
  { lock; sm_key_priv; sm_key_pub; denom_ht; revoked_ht }

let init conn =
  match load conn with
  | Ok None ->
      let t = make_new () in
      Logs.info (fun m -> m "secmod_denom initialized with fresh keys");
      t
  | Ok (Some v) ->
      Logs.info (fun m -> m "secmod_denom initialized from storage");
      v
  | Error _ -> Fmt.failwith "secmod_denom init failure."