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

clean up future_sk/dn

Browse source
This commit is contained in:
swrup 2026-02-24 19:04:22 +01:00 • committed by Swrup
parent 104666b7ea
commit 4ff8d9840f
2 changed files with 74 additions and 134 deletions
Download patch file Download diff file Expand all files Collapse all files

53
src/http_management.ml
View file

@ -9,16 +9,18 @@ module Keys_get = struct
Logs.info (fun m -> m "GET /management/keys/");
let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
let res =
let* v = Keys.make_future_keys_response () in
let v = Keys.make_future_keys_response () in
Api.encode jsont v
in
Respond.result res req
end
module Keys_post = struct
let verify_dn (module Keys : Keys.S) fdn denom_hash master_sig =
let verify_fdn (module Keys : Keys.S)
DenomSignature.{ h_denom_pub; master_sig } =
let open FutureDenom in
let open Signatures.DenominationKeyValidity in
let* fdn = Keys.find_future_denomination h_denom_pub in
verify Config.master_public_key master_sig
{
R.master= Config.master_public_key;
@ -31,54 +33,23 @@ module Keys_post = struct
fee_deposit= fdn.fee_deposit;
fee_refresh= fdn.fee_refresh;
fee_refund= fdn.fee_refund;
denom_hash;
denom_hash= h_denom_pub;
}
let verify_denom_sigs (module Keys : Keys.S) denom_sigs =
let* fdn_l = Keys.future_denominations () in
let fdn_l =
List.map
(fun fdn ->
let h_pub =
(* TODO DenominationHash.of_denom_pub *)
DenominationHash.hash
(DenominationKey.to_octets fdn.FutureDenom.denom_pub)
in
(h_pub, fdn))
fdn_l
in
list_iter
(fun DenomSignature.{ h_denom_pub; master_sig } ->
match List.assoc_opt h_denom_pub fdn_l with
| None -> Error "future denomination not found"
| Some fdn -> verify_dn (module Keys) fdn h_denom_pub master_sig)
denom_sigs
let verify_sk (module Keys : Keys.S)
FutureSignKey.
{ key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ }
master_sig =
let verify_fsk (module Keys : Keys.S) SignKeySignature.{ key; master_sig } =
let open Signatures.ExchangeSigningKeyValidity in
let* fsk = Keys.find_future_signkey key in
verify Config.master_public_key master_sig
{
R.start= stamp_start;
expire= stamp_expire;
end_= stamp_end;
R.start= fsk.stamp_start;
expire= fsk.stamp_expire;
end_= fsk.stamp_end;
signkey_pub= key;
}
let verify_signkey_sigs (module Keys : Keys.S) signkey_sigs =
let* fsk_l = Keys.future_signkeys () in
list_iter
(fun SignKeySignature.{ key; master_sig } ->
match List.find_opt (fun sk -> sk.FutureSignKey.key = key) fsk_l with
| None -> Error "future signkey not found"
| Some fsk -> verify_sk (module Keys) fsk master_sig)
signkey_sigs
let verify keys MasterSignatures.{ denom_sigs; signkey_sigs } =
let* () = verify_signkey_sigs keys signkey_sigs in
let* () = verify_denom_sigs keys denom_sigs in
let* () = list_iter (verify_fsk keys) signkey_sigs in
let* () = list_iter (verify_fdn keys) denom_sigs in
Ok ()
let do_ ~db_conn:_ (module Keys : Keys.S)

155
src/keys.ml
View file

@ -11,9 +11,9 @@ module type S = sig
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 make_future_keys_response : unit -> Api.FutureKeysResponse.t result
val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t result
val find_future_denomination : denom_hash -> Api.FutureDenom.t result
val make_future_keys_response : unit -> Api.FutureKeysResponse.t
val certify_future_signkey :
eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
@ -66,8 +66,8 @@ module Make (Conn : Pg.CONN) : S = struct
| _ ->
Logs.warn (fun m ->
m
"signkeys found in database are missing from secmod, (unclean \
database/secmod state?)");
"some signkeys found in database are missing from secmod, \
(unclean database/secmod state?)");
l
let denominations () =
@ -82,11 +82,11 @@ module Make (Conn : Pg.CONN) : S = struct
| _ ->
Logs.warn (fun m ->
m
"denominations found in database are missing from secmod, \
"some denominations found in database are missing from secmod, \
(unclean database/secmod state?)");
l
let make_future_sk ~pub ~start ~expire =
let make_future_sk (pub, (start, expire)) =
let open Time in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire = Timestamp.of_absolute expire in
@ -104,7 +104,15 @@ module Make (Conn : Pg.CONN) : S = struct
Api.FutureSignKey.
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
let make_future_dn ~coin ~pub ~start =
let coin_of_section_name section_name =
Config.Coin.all_coins
|> List.find_opt (fun coin -> coin.Config.Coin.section_name = section_name)
|> function
| None ->
Fmt.failwith "coin section `%s` not found in configuration" section_name
| Some v -> v
let make_future_dn (h_pub, (section_name, pub, start)) =
let open Time in
let Config.Coin.
{
@ -121,7 +129,7 @@ module Make (Conn : Pg.CONN) : S = struct
rsa_keysize= _;
age_restricted= _;
} =
coin
coin_of_section_name section_name
in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire_withdraw =
@ -138,7 +146,6 @@ module Make (Conn : Pg.CONN) : S = struct
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
signf Sm_rsa.sign_secmod
@ -165,59 +172,31 @@ module Make (Conn : Pg.CONN) : S = struct
denom_secmod_sig;
}
let future_signkeys () =
Sm_eddsa.keys ()
|> list_filter_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 find_future_signkey pub =
match Sm_eddsa.find_key pub with
| None -> Error "future signkey not found"
| Some (pub, (t1, t2)) ->
let fsk = make_future_sk (pub, (t1, t2)) in
Ok fsk
let future_denominations () =
Sm_rsa.keys ()
|> list_filter_map (fun (h_pub, (section_name, pub, t1)) ->
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))
let find_future_denomination h_pub =
match Sm_rsa.find_key h_pub with
| None -> Error "future denomination not found"
| Some (h_pub, (section_name, pub, t1)) ->
let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in
Ok future_dn
let make_future_keys_response () =
let* future_signkeys = future_signkeys () in
let* future_denoms = future_denominations () in
Ok
Api.FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub= Config.Exchange.master_public_key;
denom_secmod_public_key= Sm_rsa.sm_pub;
signkey_secmod_public_key= Sm_eddsa.sm_pub;
}
let future_signkeys = Sm_eddsa.keys () |> List.map make_future_sk in
let future_denoms = Sm_rsa.keys () |> List.map make_future_dn in
Api.FutureKeysResponse.
{
future_denoms;
future_signkeys;
master_pub= Config.Exchange.master_public_key;
denom_secmod_public_key= Sm_rsa.sm_pub;
signkey_secmod_public_key= Sm_eddsa.sm_pub;
}
let sk_of_future_sk future_sk master_sig =
let Api.FutureSignKey.
@ -268,43 +247,33 @@ module Make (Conn : Pg.CONN) : S = struct
let certify_future_signkey pub master_sig =
match Sm_eddsa.find_key pub with
| 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 ()
| Some (pub, (t1, t2)) -> (
let* opt = find_signkey pub in
match opt with
| Some _sk ->
Logs.info (fun m -> m "signkey already certified");
Ok ()
| None ->
(* rebuild it *)
let future_sk = make_future_sk (pub, (t1, 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 =
match Sm_rsa.find_key h_pub with
| None -> Error "future denomination not found"
| Some (h_pub, (section_name, pub, t1)) ->
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 ()
| Some (h_pub, (section_name, pub, t1)) -> (
let* opt = find_denomination h_pub in
match opt with
| Some _dn ->
Logs.info (fun m -> m "denomination already certified");
Ok ()
| None ->
let future_dn = make_future_dn (h_pub, (section_name, pub, 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