wip cram test

test/validate.ml

@@ -0,0 +1,145 @@
+open Syntax
+open Hash
+
+let keys content =
+  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 "version incompatible"
+  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_exchange_signing_key_validity ~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 "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_denomination_key_validity ~key:v.master_public_key)
+  in
+
+  let* () =
+    (* TODO O(n^2) *)
+    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; auditor_sig } ->
+                  (denom_pub_h, auditor_url_hash, auditor_pub, auditor_sig)))
+    |> list_iter
+         (fun (denom_pub_h, auditor_url_hash, auditor_pub, auditor_sig) ->
+           let open Denomination in
+           denom_l |> List.find_opt (fun dn -> dn.h_pub = denom_pub_h)
+           |> function
+           | None -> Fmt.error "auditor denomination key not found"
+           | Some dn ->
+               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* content =
+    Result.bind (Fpath.of_string file) Bos.OS.File.read |> unwrap_msg
+  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 ())