open Api let mk_future_denom ~sm_denom_priv ({ pub; priv= _; section_name; value; stamp_start; stamp_expire_withdraw; stamp_expire_deposit; stamp_expire_legal; fee_withdraw; fee_deposit; fee_refresh; fee_refund; age_mask; h_pub; master_sig= _; } : Denomination.t) = let denom_pub = DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub } in let denom_secmod_sig = let open Api_sig.DenominationKeyAnnouncementPS in let h_denom_pub = h_pub in let h_section_name = Bin_type.Hash_64_cstr.hash section_name in let anchor_time = stamp_start in let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn in sign ~key:sm_denom_priv { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in 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; } let mk_future_signkey ~sm_signkey_priv ({ pub; priv= _; stamp_start; stamp_expire; stamp_end; master_sig= _ } : Signkey.t) = let signkey_secmod_sig = let open Api_sig.SigningKeyAnnouncementPS in let exchange_pub = pub in let anchor_time = stamp_start in let duration = Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn in sign ~key:sm_signkey_priv { exchange_pub; anchor_time; duration } in FutureSignKey. { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t) ~(sm_denom : Secmod_denom.t) = let future_signkeys = Secmod_signkey.get_signkeys sm_signkey |> List.filter (fun k -> Option.is_none k.Signkey.master_sig) |> List.map (fun signkey -> let sm_signkey_priv = (Secmod_signkey.get_sm_key sm_signkey).Signkey.priv in mk_future_signkey ~sm_signkey_priv signkey) in let future_denoms = Secmod_denom.get_denoms sm_denom |> List.filter (fun k -> Option.is_none k.Denomination.master_sig) |> List.map (fun denom -> let sm_denom_priv = (Secmod_denom.get_sm_key sm_denom).Signkey.priv in mk_future_denom ~sm_denom_priv denom) in let master_pub = Config.Exchange.master_public_key in let denom_secmod_public_key = (Secmod_denom.get_sm_key sm_denom).pub in let signkey_secmod_public_key = (Secmod_signkey.get_sm_key sm_signkey).pub in FutureKeysResponse. { future_denoms; future_signkeys; master_pub; denom_secmod_public_key; signkey_secmod_public_key; } (* - ** - *) let verify_denom_signature ~sm_denoms DenomSignature.{ h_denom_pub; master_sig } = let open Syntax in let denom_hash = Bin_type.DenominationHash.of_octets (HashCode.to_octets h_denom_pub) in let* denom = let opt = List.find_opt (fun (denom : Denomination.t) -> denom.h_pub = denom_hash) sm_denoms in match opt with | None -> Fmt.error "404 not found, One of the keys for which a signature was provided \ is unknown to the exchange." | Some denom -> Ok denom in let open Api_sig.DenominationKeyValidityPS in let r : r = { master= Config.master_public_key; start= denom.stamp_start; expire_withdraw= denom.stamp_expire_withdraw; expire_spend= denom.stamp_expire_deposit; expire_legal= denom.stamp_expire_legal; value= denom.value; fee_withdraw= denom.fee_withdraw; fee_deposit= denom.fee_deposit; fee_refresh= denom.fee_refresh; denom_hash; } in verify ~key:Config.master_public_key master_sig r let verify_signkey_signature ~sm_signkeys SignKeySignature.{ key; master_sig } = let open Syntax in let* signkey = let opt = List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key) sm_signkeys in match opt with | None -> Fmt.error "404 not found, One of the keys for which a signature was provided \ is unknown to the exchange." | Some signkey -> Ok signkey in let open Api_sig.ExchangeSigningKeyValidityPS in let r : r = { start= signkey.stamp_start; expire= signkey.stamp_expire; end_= signkey.stamp_end; signkey_pub= signkey.pub; } in verify ~key:Config.master_public_key master_sig r let verify_master_signatures ~sm_signkeys ~sm_denoms MasterSignatures.{ denom_sigs; signkey_sigs } = let open Syntax in let* () = list_iter (verify_denom_signature ~sm_denoms) denom_sigs in let* () = list_iter (verify_signkey_signature ~sm_signkeys) signkey_sigs in Ok () (* --- *) let respond_with_plain_text_error ?status e req = let open Vif.Response in let open Syntax in let status = Option.value ~default:`Bad_request status in let* () = add ~field:"content-type" "text/plain; charset=utf-8" in let* () = with_string req e in respond status let respond_with_ok_json content req = let open Vif.Response in let open Syntax in let* () = add ~field:"content-type" "application/json" in let* () = with_string req content in respond `OK let respond_with_res res req = match res with | Error err -> respond_with_plain_text_error err req | Ok content -> respond_with_ok_json content req let keys_get req server _env = let sm_signkey = Vif.Server.device Devices.secmod_signkey server in let sm_denom = Vif.Server.device Devices.secmod_denom server in let res = let v = mk_future_keys_response ~sm_signkey ~sm_denom in let s = Api.encode_exn Api.FutureKeysResponse.jsont v in Ok s in respond_with_res res req let keys_post_jsont = MasterSignatures.jsont let keys_post req server _env = let sm_signkey = Vif.Server.device Devices.secmod_signkey server in let sm_denom = Vif.Server.device Devices.secmod_denom server in let res = let open Syntax in let* master_signatures = match Vif.Request.of_json req with | Ok (v : MasterSignatures.t) -> Ok v | Error (`Msg msg) -> Logs.err (fun m -> m "Invalid JSON: %s" msg); Error msg in let* () = let sm_denoms = Secmod_denom.get_denoms sm_denom in let sm_signkeys = Secmod_signkey.get_signkeys sm_signkey in verify_master_signatures ~sm_signkeys ~sm_denoms master_signatures in (* TODO let* () = update_master_signatures () in*) Ok "" in respond_with_res res req