mte/test/validate.ml
2026-07-03 19:53:23 +02:00

141 lines
4.2 KiB
OCaml

let keys content =
let open Syntax in
let open Hash in
let open Api in
let open ExchangeKeysResponse in
let* v = Api.decode jsont content in
let* () =
if
Libtool_version.is_compatible
~implementation:Libtool_version.mte_protocol_version v.version
then Ok ()
else Fmt.error_msg "incompatible version"
in
(* TODO json hash
validate wire *)
let* () =
let open AggregateTransferFee in
v.wire_fees
|> String_map.bindings
|> List.concat_map (fun (wire_method, l) ->
List.map (fun item -> (wire_method, item)) l)
|> list_iter
(fun
(wire_method, { wire_fee; closing_fee; start_date; end_date; sig_ })
->
let open Signatures.MasterWireFee in
verify v.master_public_key sig_
{
h_wire_method= H64_cstring.hash wire_method;
start_date;
end_date;
wire_fee;
closing_fee;
})
in
let* () =
v.global_fees
|> list_iter (GlobalFees.verify_global_fees ~key:v.master_public_key)
in
let sk_l = List.map SignKey.to_signkey v.signkeys in
let* () =
sk_l |> list_iter (Signkey.verify ~master_key:v.master_public_key)
in
let* () =
let opt = List.find_opt (fun sk -> sk.Signkey.pub = v.exchange_pub) sk_l in
match opt with
| None -> Fmt.error_msg "exchange_pub is not in signkeys list"
| Some _sk ->
(* todo add a --now option if we want to validate timestamps
let now = Timestamp.of_ptime (Ptime_clock.now ()) in
if Signkey.is_valid_at ~timestamp:now sk then Ok ()
else Fmt.error "exchange_pub is not valid at the current time"
*)
Ok ()
in
let* () =
let open Signatures.ExchangeKeySet in
verify v.exchange_pub v.exchange_sig
R.
{
list_issue_date= v.list_issue_date;
hc= Denomination.hash_over_master_sigs v.denominations;
}
in
let denom_l = v.denominations |> Denomination.denoms_of_denomgroups in
let* () =
denom_l |> list_iter (Denomination.verify ~master_key:v.master_public_key)
in
let* () =
let dn_ht = Hashtbl.create 0xff in
List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub dn) denom_l;
v.auditors
|> List.concat_map
(fun
AuditorKeys.
{ auditor_pub; auditor_url; auditor_name= _; denomination_keys }
->
let auditor_url_hash = H64_cstring.hash auditor_url in
denomination_keys
|> List.map
(fun
AuditorDenominationKey.{ denom_pub_h= h_pub; auditor_sig } ->
(h_pub, (auditor_url_hash, auditor_pub, auditor_sig))))
|> list_iter (fun (h_pub, (auditor_url_hash, auditor_pub, auditor_sig)) ->
Hashtbl.find_opt dn_ht h_pub |> function
| None -> Fmt.error_msg "auditor denomination key not found"
| Some dn ->
let open Denomination in
let open Signatures.ExchangeKeyValidity in
verify auditor_pub auditor_sig
{
auditor_url_hash;
master= auditor_pub;
start= dn.stamp_start;
expire_withdraw= dn.stamp_expire_withdraw;
expire_spend= dn.stamp_expire_deposit;
expire_legal= dn.stamp_expire_legal;
value= dn.value;
fee_withdraw= dn.fee_withdraw;
fee_deposit= dn.fee_deposit;
fee_refresh= dn.fee_refresh;
denom_hash= dn.h_pub;
})
in
Ok ()
(* --- *)
open Cmdliner
open Cmdliner.Term.Syntax
let keys_cmd =
let file =
let doc = "JSON file with /keys response" in
Arg.(required & pos 0 (some filepath) None & info [] ~doc)
in
let doc = "Validate a /keys response" in
Cmd.make (Cmd.info "keys" ~doc)
@@
let+ file = file in
let open Syntax in
Result.unwrap_err
@@
let* content = Bos.OS.File.read (Fpath.v file) in
keys content
let cli =
let info =
let doc = "Testing tool to validate exchange responses" in
Cmd.info "validate" ~doc
in
Cmd.group info [ keys_cmd ]
let main () = Cmd.eval_result cli
let () = if !Sys.interactive then () else exit (main ())