rename

src/keys.ml

@@ -0,0 +1,478 @@
+module type S = sig
+  open Crypto
+
+  val sm_pubkey : eddsa_pub
+  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
+
+  val get_signkeys : unit -> Signkey.t list
+  val get_denominations : unit -> Denomination.t list
+  val get_future_signkeys : unit -> Api.FutureSignKey.t list
+  val get_future_denominations : unit -> Api.FutureDenom.t list
+  val find_signkey : eddsa_pub -> Signkey.t option
+  val find_denomination : denom_hash -> Denomination.t option
+  val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
+  val find_future_denomination : denom_hash -> Api.FutureDenom.t option
+
+  val certify_future_signkey :
+    eddsa_pub ->
+    master_sig:Signatures.ExchangeSigningKeyValidity.t ->
+    (unit, string) result
+
+  val certify_future_denomination :
+    denom_hash ->
+    master_sig:Signatures.DenominationKeyValidity.t ->
+    (unit, string) result
+
+  val revoke_signkey :
+    eddsa_pub ->
+    Signatures.MasterSigningKeyRevocation.t ->
+    (unit, string) result
+
+  val revoke_denomination :
+    denom_hash ->
+    Signatures.MasterDenominationKeyRevocation.t ->
+    (unit, string) result
+
+  val save : unit -> (unit, string) result
+end
+
+module Make (Conn : Pg.CONN) = struct
+  open Syntax
+  open Crypto
+  module DenominationHash = Hash.DenominationHash
+
+  let read fname = Bos.OS.File.read fname |> unwrap_err_msg
+  let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
+  let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
+  let write_rsa fname priv = write fname (RsaPrivateKey.to_octets priv)
+
+  let read_eddsa fname =
+    let* data = read fname in
+    EddsaPrivateKey.of_octets data
+
+  let read_rsa fname =
+    let* data = read fname in
+    RsaPrivateKey.of_octets data
+
+  type sk = Signkey.t
+  type future_sk = Api.FutureSignKey.t
+  type dn = Denomination.t
+  type future_dn = Api.FutureDenom.t
+
+  (* TODO ! use lock *)
+  (* not sure what to do with coin section_name, rm if possible *)
+  type t = {
+    sm_key: eddsa_priv;
+    sm_pubkey: eddsa_pub;
+    sk_ht: (eddsa_pub, sk) Hashtbl.t;
+    dn_ht: (denom_hash, dn) Hashtbl.t;
+    sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
+    dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
+    future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t;
+    future_dn_ht: (denom_hash, future_dn) Hashtbl.t;
+    future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
+    future_dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
+    dn_section_name_ht: (denom_hash, string) Hashtbl.t;
+  }
+
+  let conn = (module Conn : Pg.CONN)
+  let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key")
+  let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i)
+
+  let dn_fname section_name =
+    Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name)
+
+  let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s
+
+  let make_future_sk t =
+    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 = Timestamp.of_absolute start in
+    let stamp_expire = Timestamp.of_absolute expire in
+    let stamp_end = stamp_expire in
+    let priv, pub = Mirage_crypto_ec.Ed25519.generate () 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:(sign_with_sm_key t) { exchange_pub; anchor_time; duration }
+    in
+    let future_sk =
+      Api.FutureSignKey.
+        { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+    in
+    Hashtbl.replace t.future_sk_ht pub future_sk;
+    Hashtbl.replace t.future_sk_key_ht pub priv;
+    ()
+
+  let make_future_dn t
+      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 start = Time.Absolute.of_ptime (Ptime_clock.now ()) 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 priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () 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:(sign_with_sm_key t)
+        { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+    in
+    let future_dn =
+      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;
+        }
+    in
+    Hashtbl.replace t.future_dn_ht h_pub future_dn;
+    Hashtbl.replace t.future_dn_key_ht h_pub priv;
+    ()
+
+  let make_new () =
+    let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in
+    let t =
+      {
+        sm_key;
+        sm_pubkey;
+        sk_ht= Hashtbl.create 0xff;
+        dn_ht= Hashtbl.create 0xff;
+        sk_key_ht= Hashtbl.create 0xff;
+        dn_key_ht= Hashtbl.create 0xff;
+        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;
+        dn_section_name_ht= Hashtbl.create 0xff;
+      }
+    in
+    make_future_sk t;
+    List.iter (make_future_dn t) Config.Coin.all_coins;
+    t
+
+  let database_find_sk conn pub =
+    let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
+    match opt with
+    | None -> Fmt.error "secmod: signkey data not found in database"
+    | Some sk_data -> Ok sk_data
+
+  let database_find_dn conn h_pub =
+    let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
+    match opt with
+    | None -> Fmt.error "secmod: denomination data not found in database"
+    | Some dn_data -> Ok dn_data
+
+  let list_to_ht l = Hashtbl.of_seq (List.to_seq l)
+
+  let load () =
+    let* sm_key = read_eddsa sm_key_fname in
+    let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
+
+    let* sk_keys = list_map read_eddsa (List.init 1 sk_fname) in
+    let* sk_l =
+      list_map
+        (fun priv ->
+          let pub = EddsaPrivateKey.pub_of_priv priv in
+          let+ sk = database_find_sk conn pub in
+          ((pub, sk), (pub, priv)))
+        sk_keys
+    in
+    let sk_ht, sk_key_ht =
+      match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
+    in
+
+    let dn_section_name_ht = Hashtbl.create 0xff in
+    let* dn_keys =
+      list_map
+        (fun coin ->
+          let section_name = coin.Config.Coin.section_name in
+          let+ priv = read_rsa (dn_fname section_name) in
+          (section_name, priv))
+        Config.Coin.all_coins
+    in
+    let* dn_l =
+      list_map
+        (fun (section_name, priv) ->
+          let h_pub =
+            priv
+            |> RsaPrivateKey.pub_of_priv
+            |> RsaPublicKey.to_octets
+            |> DenominationHash.hash
+          in
+          (* fill dn_section_name_ht *)
+          Hashtbl.replace dn_section_name_ht h_pub section_name;
+          let+ dn = database_find_dn conn h_pub in
+          ((h_pub, dn), (h_pub, priv)))
+        dn_keys
+    in
+    let dn_ht, dn_key_ht =
+      match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
+    in
+    (* future keys are not stored anywhere until they are certified with a master_sig
+       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;
+        dn_section_name_ht;
+      }
+    in
+    Ok t
+
+  let init () =
+    let dir = Config.secmod_dir in
+    let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
+    if b then
+      Logs.info (fun m -> m "secmod: created directory `%a`" Fpath.pp dir);
+    let* l =
+      Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
+    in
+    match List.is_empty l with
+    | true ->
+        Logs.info (fun m -> m "secmod: empty storage, generating fresh keys");
+        let t = make_new () in
+        Ok t
+    | false ->
+        Logs.info (fun m -> m "secmod: loading keys from storage");
+        load ()
+
+  let t =
+    match init () with
+    | Error e -> Fmt.failwith "secmod initialization failure: `%s`." e
+    | Ok t ->
+        Logs.info (fun m -> m "secmod initialized");
+        t
+
+  let sm_pubkey = t.sm_pubkey
+  let sign_with_sm_key s = sign_with_sm_key t s
+
+  let sign_with_signkey ~pub s =
+    match Hashtbl.find_opt t.sk_key_ht pub with
+    | None -> Fmt.failwith "secmod sign_with_signkey failure: not found."
+    | Some priv -> EddsaSignature.sign ~key:priv s
+
+  let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_pubkey s ~msg
+
+  let verify_with_master_key =
+    EddsaSignature.verify ~key:Config.master_public_key
+
+  let verify_with_signkey ~pub s ~msg =
+    match Hashtbl.find_opt t.sk_ht pub with
+    | None -> Fmt.failwith "secmod verify_with_signkey failure: not found."
+    | Some _sk -> EddsaSignature.verify ~key:pub s ~msg
+
+  let get_signkeys () = t.sk_ht |> Hashtbl.to_seq_values |> List.of_seq
+  let get_denominations () = t.dn_ht |> Hashtbl.to_seq_values |> List.of_seq
+
+  let get_future_signkeys () =
+    t.future_sk_ht |> Hashtbl.to_seq_values |> List.of_seq
+
+  let get_future_denominations () =
+    t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq
+
+  let find_signkey pub = Hashtbl.find_opt t.sk_ht pub
+  let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub
+  let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub
+  let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_pub
+
+  let certify_future_signkey pub ~master_sig =
+    match
+      ( Hashtbl.find_opt t.future_sk_ht pub,
+        Hashtbl.find_opt t.future_sk_key_ht pub )
+    with
+    | None, _ | _, None ->
+        Error "secmod certify_future_signkey: future signkey not found."
+    | Some future_sk, Some priv -> (
+        match Hashtbl.find_opt t.sk_ht pub with
+        | Some _sk -> Error "secmod certify_future_signkey: already certified"
+        | None ->
+            let Api.FutureSignKey.
+                  {
+                    key;
+                    stamp_start;
+                    stamp_expire;
+                    stamp_end;
+                    signkey_secmod_sig= _;
+                  } =
+              future_sk
+            in
+            let sk =
+              Signkey.
+                {
+                  pub= key;
+                  stamp_start;
+                  stamp_expire;
+                  stamp_end;
+                  master_sig;
+                  revoked_sig= None;
+                }
+            in
+            Hashtbl.replace t.sk_ht pub sk;
+            Hashtbl.replace t.sk_key_ht pub priv;
+            Hashtbl.remove t.future_sk_ht pub;
+            Hashtbl.remove t.future_sk_key_ht pub;
+
+            let* () = Pg.insert_signkey (module Conn) sk |> unwrap_err_caqti in
+            Ok ())
+
+  let certify_future_denomination h_pub ~master_sig =
+    match
+      ( Hashtbl.find_opt t.future_dn_ht h_pub,
+        Hashtbl.find_opt t.future_dn_key_ht h_pub )
+    with
+    | None, _ | _, None ->
+        Error
+          "secmod certify_future_denomination: future denomination not found."
+    | Some future_dn, Some priv -> (
+        match Hashtbl.find_opt t.dn_ht h_pub with
+        | Some _dn ->
+            Error "secmod certify_future_denomination: already certified"
+        | None ->
+            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
+            let dn =
+              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;
+                }
+            in
+            Hashtbl.replace t.dn_ht h_pub dn;
+            Hashtbl.replace t.dn_key_ht h_pub priv;
+            Hashtbl.replace t.dn_section_name_ht h_pub section_name;
+            Hashtbl.remove t.future_dn_ht h_pub;
+            Hashtbl.remove t.future_dn_key_ht h_pub;
+
+            let* () = Pg.insert_denom (module Conn) dn |> unwrap_err_caqti in
+            Ok ())
+
+  let revoke_signkey pub revoked_sig =
+    match Hashtbl.find_opt t.sk_ht pub with
+    | None -> Error "secmod revoke_signkey: signkey not found."
+    | Some sk ->
+        let sk = { sk with revoked_sig= Some revoked_sig } in
+        Hashtbl.replace t.sk_ht pub sk;
+
+        (* TODO revoke, apply to database *)
+        Ok ()
+
+  let revoke_denomination pub revoked_sig =
+    match Hashtbl.find_opt t.dn_ht pub with
+    | None -> Error "secmod revoke_denomination: denomination not found."
+    | Some dn ->
+        let dn = { dn with revoked_sig= Some revoked_sig } in
+        Hashtbl.replace t.dn_ht pub dn;
+
+        (* TODO revoke, apply to database *)
+        Ok ()
+
+  let save () =
+    let* () = write_eddsa sm_key_fname t.sm_key in
+    let* () =
+      Hashtbl.to_seq_values t.sk_key_ht
+      |> List.of_seq
+      |> List.mapi (fun i priv -> write_eddsa (sk_fname i) priv)
+      |> list_iter Fun.id
+    in
+    let* () =
+      Hashtbl.to_seq t.dn_key_ht
+      |> List.of_seq
+      |> list_iter (fun (h_pub, priv) ->
+          match Hashtbl.find_opt t.dn_section_name_ht h_pub with
+          | None -> Error "secmod save: invalid state, section_name not found"
+          | Some section_name -> write_rsa (dn_fname section_name) priv)
+    in
+    Logs.info (fun m -> m "saved secmod private keys data");
+    Ok ()
+end