mte/src/secmod.ml

module type S = sig
  open Crypto

  val sign_with_sm_key : string -> eddsa_sig
  val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
  val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
  val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result

  val verify_with_signkey :
    pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result

  (* TODO query database instead? *)
  val get_sm_key_pub : unit -> eddsa_pub
  val get_signkeys_data : unit -> Signkey.t list
  val get_denoms_data : unit -> Denomination.t list
  val find_signkey_data : eddsa_pub -> Signkey.t option
  val find_denomination : denomination_hash -> Denomination.t option
  val find_denom_section_name : denomination_hash -> string option

  (* - management operations - *)
  (* TODO
   problem of keeping db and secmod state syncronized
   do db interaction from secmod? *)

  val add_signkey_master_signatures :
    (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list ->
    (unit, string) result

  val add_denom_master_signatures :
    (denomination_hash * Signatures.DenominationKeyValidity.t) list ->
    (unit, string) result

  val revoke_signkey :
    eddsa_pub ->
    Signatures.MasterSigningKeyRevocation.t ->
    (unit, string) result

  val revoke_denomination :
    denomination_hash ->
    Signatures.MasterDenominationKeyRevocation.t ->
    (unit, string) result

  val store : unit -> (unit, string) result
end

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

  type sk = Signkey.t
  type future_sk = Api.FutureSignKey.t
  type dn = Denomination.t
  type future_dn = Api.FutureDenom.t

  (* TODO use lock *)
  type t = {
    sm_key: eddsa_priv;
    sm_pubkey: eddsa_pub;
    sk_ht: (eddsa_pub, sk) Hashtbl.t;
    dn_ht: (rsa_pub, dn) Hashtbl.t;
    sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
    dn_key_ht: (rsa_pub, rsa_priv) Hashtbl.t;
    future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t;
    future_dn_ht: (rsa_pub, future_dn) Hashtbl.t;
    future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
    future_dn_key_ht: (rsa_pub, rsa_priv) Hashtbl.t;
  }

  let database_find_sk conn fname pub =
    let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
    match opt with
    | None ->
        Fmt.error
          "load_signkey error, no associated data found in database for \
           signkey `%s`."
          (Fpath.to_string fname)
    | Some sk_data -> Ok sk_data

  let database_find_dn conn ~section_name pub =
    let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
    let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
    match opt with
    | None ->
        Fmt.error
          "load_denom error no associated metadata found in database for \
           denomination `%s`."
          section_name
    | Some dn_data -> Ok dn_data

  (*
        let pub = EddsaPrivateKey.pub_of_priv priv in
        let* sk = db_lookup_signkey_data conn fname pub in
        let signkey = { priv; sk_data } in
        Ok (Some signkey)
        *)
  (*
            match opt with
            | None -> Ok None
            | Some priv ->
                (* todo: could check that coin config match db values *)
                let* dn_data = db_lookup_denomination conn ~section_name priv in
                Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name;
                let denom = { priv; dn_data } in
                Ok (Some denom))
                *)

  let load conn =
    let error_invalid_state =
      Fmt.error "secmod load error: invalid store state."
    in
    let* sm_key = Data_file.read_eddsa Fpath.(Config.secrets_dir / "sk_sm") in
    let* sk_keys =
      let l =
        List.init 1 (fun i -> Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i))
      in
      let* l =
        list_map
          (fun fname ->
            let+ opt = Data_file.read_eddsa fname in
            Option.map (fun priv -> (fname, priv)) opt)
          l
      in
      match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
    in
    let* dn_keys =
      let* l =
        let open Config.Coin in
        list_map
          (fun coin ->
            let section_name = coin.section_name in
            let fname = Fpath.(Config.secrets_dir / section_name) in
            let+ opt = Data_file.read_rsa fname in
            Option.map (fun priv -> (section_name, priv)) opt)
          all_coins
      in
      match Syntax.opt_list l with
      | Error () -> error_invalid_state
      | Ok opt -> Ok opt
    in
    match (sm_key, sk_keys, dn_keys) with
    | None, None, None -> Ok None
    | Some sm_key, Some sk_keys, Some dn_keys ->
        let list_to_ht l = Hashtbl.of_seq (List.to_seq l) in
        let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
        (* sk *)
        let* l =
          list_map
            (fun (fname, priv) ->
              let pub = EddsaPrivateKey.pub_of_priv priv in
              let+ sk = database_find_sk conn fname pub in
              ((pub, sk), (pub, priv)))
            sk_keys
        in
        let sk_ht, sk_key_ht =
          let sk_l, priv_l = List.split l in
          (list_to_ht sk_l, list_to_ht priv_l)
        in
        (* dn *)
        let* l =
          list_map
            (fun (section_name, priv) ->
              let pub = RsaPrivateKey.pub_of_priv priv in
              let+ dn = database_find_dn conn ~section_name pub in
              ((pub, dn), (pub, priv)))
            dn_keys
        in
        let dn_ht, dn_key_ht =
          let dn_l, priv_l = List.split l in
          (list_to_ht dn_l, list_to_ht priv_l)
        in
        (* future keys are not stored (until they are signed)
           so we don't have any future key to load *)
        let t =
          {
            sm_key;
            sm_pubkey;
            sk_ht;
            dn_ht;
            sk_key_ht;
            dn_key_ht;
            future_sk_ht= Hashtbl.create 0xff;
            future_dn_ht= Hashtbl.create 0xff;
            future_sk_key_ht= Hashtbl.create 0xff;
            future_dn_key_ht= Hashtbl.create 0xff;
          }
        in
        Ok (Some t)
    | _, _, _ -> error_invalid_state

  let make_new_signkey () =
    let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
    let expire =
      Time.Absolute.add start Config.Exchange.signkey_legal_duration
    in
    let stamp_start = Time.Timestamp.of_absolute start in
    let stamp_expire = Time.Timestamp.of_absolute expire in
    let stamp_end = stamp_expire in
    let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
    let master_sig = None in
    let revoked_sig = None in
    let sk_data =
      Signkey.
        { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
    in
    { priv; sk_data }

  let make_new_denom
      Config.Coin.
        {
          section_name= _;
          value;
          duration_withdraw;
          duration_spend;
          duration_legal;
          fee_withdraw;
          fee_deposit;
          fee_refresh;
          fee_refund;
          cipher;
          rsa_keysize;
          age_restricted= _;
        } =
    assert (cipher = `RSA);
    let open Time in
    let start = Absolute.of_ptime (Ptime_clock.now ()) in
    let stamp_start = Timestamp.of_absolute start in
    let stamp_expire_withdraw =
      Timestamp.of_absolute @@ Absolute.add start duration_withdraw
    in
    let stamp_expire_deposit =
      Timestamp.of_absolute @@ Absolute.add start duration_spend
    in
    let stamp_expire_legal =
      Timestamp.of_absolute @@ Absolute.add start duration_legal
    in

    let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in
    let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
    let master_sig = None in
    let revoked_sig = None in
    let dn_data =
      Denomination.
        {
          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;
        }
    in
    { priv; dn_data }

  let make_new () =
    let lock = Miou.Mutex.create () in
    let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
    let sk_ht =
      [ make_new_signkey () ]
      |> List.map (fun v -> (v.sk_data.pub, v))
      |> List.to_seq
      |> Hashtbl.of_seq
    in
    let dn_section_name_ht = Hashtbl.create 0xff in
    let dn_ht =
      Config.Coin.all_coins
      |> List.map (fun coin ->
          let denom = make_new_denom coin in
          Hashtbl.replace dn_section_name_ht denom.dn_data.h_pub
            coin.section_name;
          (denom.dn_data.h_pub, denom))
      |> List.to_seq
      |> Hashtbl.of_seq
    in
    { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }

  let t =
    match load (module Conn) with
    | Ok None ->
        let t = make_new () in
        Logs.info (fun m -> m "secmod initialized with fresh keys");
        t
    | Ok (Some t) ->
        Logs.info (fun m -> m "secmod initialized from storage");
        t
    | Error e -> Fmt.failwith "secmod init failure: %s." e

  (* note: don't expose a signing function if we want a real "security module" one day *)
  let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s
  let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_key_pub s ~msg

  let verify_with_master_key s ~msg =
    EddsaSignature.verify ~key:Config.master_public_key s ~msg

  (* TODO
   - do something to force `pub` to be one of the valid signkey
     how to handle revocation?
   raise exn for now *)
  let sign_with_signkey ~pub s =
    Miou.Mutex.protect t.lock @@ fun () ->
    match Hashtbl.find_opt t.sk_ht pub with
    | None -> Fmt.failwith "secmod failure: public key not found."
    | Some signkey ->
        let v = EddsaSignature.sign ~key:signkey.priv s in
        v

  let verify_with_signkey ~pub s ~msg =
    Miou.Mutex.protect t.lock @@ fun () ->
    match Hashtbl.find_opt t.sk_ht pub with
    | None -> Error "secmod failure: public key not found."
    | Some signkey -> EddsaSignature.verify ~key:signkey.sk_data.pub s ~msg

  let get_sm_key_pub () = t.sm_key_pub

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

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

  let find_signkey pub =
    Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub

  let find_denom h_denom =
    Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.dn_ht h_denom

  let get_signkeys_data () = get_signkeys () |> List.map (fun v -> v.sk_data)
  let get_denoms_data () = get_denoms () |> List.map (fun v -> v.dn_data)

  let find_signkey_data pub =
    find_signkey pub |> Option.map (fun v -> v.sk_data)

  let find_denomination h_denom =
    find_denom h_denom |> Option.map (fun v -> v.dn_data)

  let find_denom_section_name h_denom =
    Miou.Mutex.protect t.lock @@ fun () ->
    Hashtbl.find_opt t.dn_section_name_ht h_denom

  let add_signkey_master_signatures l =
    Miou.Mutex.protect t.lock @@ fun () ->
    list_iter
      (fun (pub, master_sig) ->
        match Hashtbl.find_opt t.sk_ht pub with
        | None -> Error "secmod failure: public key not found."
        | Some signkey ->
            let sk_data =
              { signkey.sk_data with master_sig= Some master_sig }
            in
            let signkey = { signkey with sk_data } in
            let* () =
              Pg.insert_signkey (module Conn) sk_data |> unwrap_err_caqti
            in
            Hashtbl.replace t.sk_ht pub signkey;
            Ok ())
      l

  let add_denom_master_signatures l =
    Miou.Mutex.protect t.lock @@ fun () ->
    list_iter
      (fun (h_denom_pub, master_sig) ->
        match Hashtbl.find_opt t.dn_ht h_denom_pub with
        | None -> Error "secmod failure: denomination hash not found."
        | Some denom ->
            let dn_data = { denom.dn_data with master_sig= Some master_sig } in
            let denom = { denom with dn_data } in
            let* () =
              Pg.insert_denom (module Conn) dn_data |> unwrap_err_caqti
            in
            Hashtbl.replace t.dn_ht h_denom_pub denom;
            Ok ())
      l

  let revoke_signkey exchange_pub revoked_sig =
    Miou.Mutex.protect t.lock @@ fun () ->
    match Hashtbl.find_opt t.sk_ht exchange_pub with
    | None -> Error "secmod failure: denomination hash not found."
    | Some signkey ->
        let sk_data = { signkey.sk_data with revoked_sig= Some revoked_sig } in
        let signkey = { signkey with sk_data } in
        Hashtbl.replace t.sk_ht exchange_pub signkey;
        Ok ()

  let revoke_denomination h_denom_pub revoked_sig =
    Miou.Mutex.protect t.lock @@ fun () ->
    match Hashtbl.find_opt t.dn_ht h_denom_pub with
    | None -> Error "secmod failure: denomination hash not found."
    | Some denom ->
        let dn_data = { denom.dn_data with revoked_sig= Some revoked_sig } in
        let denom = { denom with dn_data } in
        Hashtbl.replace t.dn_ht h_denom_pub denom;
        Ok ()

  let store () =
    Miou.Mutex.protect t.lock @@ fun () ->
    let* () =
      Data_file.write_eddsa Fpath.(Config.secrets_dir / "sk_sm") t.sm_key_priv
    in
    let* () =
      Hashtbl.to_seq_values t.sk_ht
      |> List.of_seq
      |> List.mapi (fun i (key : signkey) ->
          let fname = Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i) in
          (fname, key.priv))
      |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
    in
    let* () =
      let* l =
        Hashtbl.to_seq_values t.dn_ht
        |> List.of_seq
        |> Syntax.list_map (fun (key : denom) ->
            let+ section_name =
              match Hashtbl.find_opt t.dn_section_name_ht key.dn_data.h_pub with
              | None -> Error "invalid state, section_name not found"
              | Some s -> Ok s
            in
            let fname = Fpath.(Config.secrets_dir / section_name) in
            (fname, key.priv))
      in
      list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l
    in
    Logs.info (fun m -> m "stored secmod data to file");
    Ok ()
end