swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2026-02-20 20:44:52 +01:00
parent 07659222dc
commit ae8ff0e6f7
7 changed files with 249 additions and 520 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/http_info.ml
View file

@ -88,7 +88,7 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
(* todo asset_type
Type of the asset. "fiat", "crypto", "regional" or "stock". *)
let asset_type = "xxx" in
let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in
let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_err_caqti in
let* wire_fees =
(* todo
where does wire_methods comes from? *)
@ -111,13 +111,12 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
let wallet_balance_limit_without_kyc = None in
let hard_limits = [] in
let zero_limits = [] in
let dn_l =
(*Pg.get_denominations db_conn |> unwrap_err_caqti *)
Keys.get_denominations ()
|>
let* dn_l =
let+ l = Keys.denominations () in
(* reverse chronological order *)
List.sort (fun a b ->
Stdlib.compare b.Denomination.stamp_start a.stamp_start)
List.sort
(fun a b -> Stdlib.compare b.Denomination.stamp_start a.stamp_start)
l
in
let list_issue_date =
match dn_l with
@ -147,11 +146,9 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
List.map denomgroup_of_denomdata l
in
let signkeys =
(*
let now = Ptime_clock.now () |> Option.some in
let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
Keys.get_signkeys ()
let* signkeys =
let+ l = Keys.signkeys () in
l
|> List.sort (fun a b ->
let open Signkey in
Stdlib.compare b.stamp_start a.stamp_start)
@ -176,9 +173,7 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
|> Hash.H64.hash
in
let open Signatures.ExchangeKeySet in
sign_f
~f:(Keys.sign_with_signkey ~pub:exchange_pub)
R.{ list_issue_date; hc }
sign_f ~f:(Keys.sign ~pub:exchange_pub) R.{ list_issue_date; hc }
in
let recoup = (* TODO /recoup *) [] in

44
src/http_management.ml
View file

@ -4,19 +4,20 @@ open Hash
module Keys_get = struct
let mk_future_keys_response (module Keys : Keys.S) =
let future_signkeys = Keys.get_future_signkeys () in
let future_denoms = Keys.get_future_denominations () in
let master_pub = Config.Exchange.master_public_key in
let denom_secmod_public_key = Keys.sm_pubkey in
let signkey_secmod_public_key = Keys.sm_pubkey in
FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub;
denom_secmod_public_key;
signkey_secmod_public_key;
}
let* future_signkeys = Keys.future_signkeys () in
let* future_denoms = Keys.future_denominations () in
let master_pub = Keys.master_pub in
let denom_secmod_public_key = Keys.secmod_rsa_pub in
let signkey_secmod_public_key = Keys.secmod_eddsa_pub in
Ok
FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub;
denom_secmod_public_key;
signkey_secmod_public_key;
}
let jsont = FutureKeysResponse.jsont
@ -24,7 +25,7 @@ module Keys_get = struct
Logs.info (fun m -> m "GET /management/keys/");
let keys = Vif.Server.device Devices.keys server in
let res =
let v = mk_future_keys_response keys in
let* v = mk_future_keys_response keys in
let s = Api.encode_exn jsont v in
Ok s
in
@ -38,10 +39,8 @@ module Keys_post = struct
let verify_denom_signature (module Keys : Keys.S)
DenomSignature.{ h_denom_pub; master_sig } =
let* denom =
Keys.find_future_denomination h_denom_pub
|> Option.to_result ~none:error_key_unknown
in
let* opt = Keys.find_future_denomination h_denom_pub in
let* denom = Option.to_result ~none:error_key_unknown opt in
let open Signatures.DenominationKeyValidity in
let r : r =
{
@ -86,16 +85,15 @@ module Keys_post = struct
let* () =
list_iter
(fun SignKeySignature.{ key; master_sig } ->
Keys.certify_future_signkey key ~master_sig)
Keys.certify_future_signkey key master_sig)
signkey_sigs
in
let* () =
list_iter
(fun DenomSignature.{ h_denom_pub; master_sig } ->
Keys.certify_future_denomination h_denom_pub ~master_sig)
Keys.certify_future_denomination h_denom_pub master_sig)
denom_sigs
in
let* () = Keys.save () in
Ok ()
let jsont = MasterSignatures.jsont
@ -117,7 +115,9 @@ module Denom_revoke = struct
let verify (module Keys : Keys.S) h_denom_pub
DenomRevocationSignature.{ master_sig } =
let open Signatures.MasterDenominationKeyRevocation in
verify_f ~f:Keys.verify_with_master_key master_sig { h_denom_pub }
verify_f
~f:(Crypto.EddsaSignature.verify ~key:Keys.master_pub)
master_sig { h_denom_pub }
let do_ (module Keys : Keys.S) h_denom_pub
DenomRevocationSignature.{ master_sig } =

623
src/keys.ml
View file

@ -1,182 +1,35 @@
type 'a result = ('a, string) Result.t
module type S = Keys_intf.S
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 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 read_eddsa fname =
let* data = read fname in
EddsaPrivateKey.of_octets data
let sign ~pub s =
Secmod_eddsa.sign ~pub s |> function
| Error e -> Fmt.failwith "sign failure: %s." e
| Ok v -> v
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 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 sm_key_fname = Fpath.(v Config.Exchange_secmod_eddsa.sm_priv_key)
let sk_fname i =
Fpath.(v Config.Exchange_secmod_eddsa.key_dir / Fmt.str "sk_%d" i)
let dn_fname section_name =
Fpath.(
v Config.Exchange_secmod_eddsa.key_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 "Keys: 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 "Keys: denomination data not found in database"
| Some dn_data -> Ok dn_data
let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti
let find_denom h_pub = Pg.find_denom conn h_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 =
@ -194,22 +47,6 @@ module Make (Conn : Pg.CONN) = struct
Api.FutureSignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
let _get_future_signkeys () =
Secmod_eddsa.keys ()
|> 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))
let make_future_dn ~coin ~pub ~start =
let Config.Coin.
{
@ -271,295 +108,181 @@ module Make (Conn : Pg.CONN) = struct
denom_secmod_sig;
}
let _get_future_denominations () =
Secmod_rsa.keys ()
|> List.map (fun (section_name, pub, t1, _t2) ->
let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
(*?? let duration_withdraw = Time.Absolute.diff t1 t2 in*)
let* opt = find_denom 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))
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 =
let future_signkeys () =
let+ 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)
(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 dn_section_name_ht = Hashtbl.create 0xff in
let* dn_keys =
let future_denominations () =
let+ l =
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
(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
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
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
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 =
Signkey.
{
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;
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
Ok t
let init () =
let dir = Fpath.v Config.Exchange_secmod_eddsa.key_dir in
let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
if b then Logs.info (fun m -> m "Keys: created directory `%a`" Fpath.pp dir);
let* l =
Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
let rsa_pub =
match denom_pub with
| Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
in
match List.is_empty l with
| true ->
Logs.info (fun m -> m "Keys: empty storage, generating fresh keys");
let t = make_new () in
Ok t
| false ->
Logs.info (fun m -> m "Keys: loading keys from storage");
load ()
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 t =
match init () with
| Error e -> Fmt.failwith "Keys: initialization failure: `%s`." e
| Ok t ->
Logs.info (fun m -> m "Keys: initialized");
t
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 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 "Keys 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 "Keys 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 "Keys certify_future_signkey: future signkey not found."
| Some future_sk, Some priv -> (
match Hashtbl.find_opt t.sk_ht pub with
| Some _sk -> Error "Keys 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 "Keys 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 "Keys 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 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 =
match Hashtbl.find_opt t.sk_ht pub with
| None -> Error "Keys revoke_signkey: signkey not found."
| Some sk ->
let sk = { sk with revoked_sig= Some revoked_sig } in
Hashtbl.replace t.sk_ht pub sk;
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 =
match Hashtbl.find_opt t.dn_ht h_pub with
| None -> Error "Keys revoke_denomination: denomination not found."
| Some dn ->
let dn = { dn with revoked_sig= Some revoked_sig } in
Hashtbl.replace t.dn_ht h_pub dn;
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
()
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 "Keys save: invalid state, section_name not found"
| Some section_name -> write_rsa (dn_fname section_name) priv)
in
Logs.info (fun m -> m "saved private keys data");
Ok ()
end

48
src/keys_intf.ml
View file

@ -1,43 +1,29 @@
type 'a result = ('a, string) Result.t
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 master_pub : eddsa_pub
val secmod_rsa_pub : eddsa_pub
val secmod_eddsa_pub : eddsa_pub
val sign : pub:eddsa_pub -> string -> eddsa_sig
val sign_denom : pub:rsa_pub -> string -> string
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 future_signkeys : unit -> Api.FutureSignKey.t list result
val future_denominations : unit -> Api.FutureDenom.t list result
val certify_future_signkey :
eddsa_pub ->
master_sig:Signatures.ExchangeSigningKeyValidity.t ->
(unit, string) result
eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
val certify_future_denomination :
denom_hash ->
master_sig:Signatures.DenominationKeyValidity.t ->
(unit, string) result
denom_hash -> Signatures.DenominationKeyValidity.t -> unit result
val revoke_signkey :
eddsa_pub ->
Signatures.MasterSigningKeyRevocation.t ->
(unit, string) result
eddsa_pub -> Signatures.MasterSigningKeyRevocation.t -> unit result
val revoke_denomination :
denom_hash ->
Signatures.MasterDenominationKeyRevocation.t ->
(unit, string) result
val save : unit -> (unit, string) result
denom_hash -> Signatures.MasterDenominationKeyRevocation.t -> unit result
end

4
src/pg.ml
View file

@ -87,7 +87,7 @@ let get_denominations =
dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
= dnr.denominations_serial"
in
fun (module Conn : CONN) -> Conn.collect_list req ()
fun (module Conn : CONN) () -> Conn.collect_list req ()
(* note: does not update revocation *)
let insert_denom =
@ -328,7 +328,7 @@ let get_wire_accounts =
credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
wire_accounts WHERE is_active"
in
fun (module Conn : CONN) -> Conn.collect_list req ()
fun (module Conn : CONN) () -> Conn.collect_list req ()
let insert_drain_profit =
let req =

12
src/secmod_eddsa.ml
View file

@ -195,6 +195,18 @@ let delete_outdated ~now =
|> List.map (fun k -> k.pub)
|> list_iter delete_key
let add_key t1 t2 =
let priv, pub = EddsaPrivateKey.generate () in
let k = { priv; pub; t1; t2 } in
Hashtbl.replace t.ht k.pub k;
()
(* delete and replace *)
let revoke_key pub =
let* k = find_key pub in
let* () = delete_key pub in
add_key k.t1 k.t2; Ok ()
(* TODO
- more checks
- sign: check time

13
src/secmod_rsa.ml
View file

@ -221,3 +221,16 @@ let delete_outdated ~now =
|> List.filter (fun k -> Absolute.compare now k.t2 >= 0)
|> List.map (fun k -> k.pub)
|> list_iter delete_key
let add_key section_name t1 t2 =
let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
let k = { section_name; priv; pub; t1; t2 } in
Hashtbl.replace t.ht k.pub k;
()
(* delete and replace *)
let revoke_key pub =
let* k = find_key pub in
let* () = delete_key pub in
add_key k.section_name k.t1 k.t2;
Ok ()