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_denom 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 = Secmod_denom.get_denoms sm_denom |> List.find_opt (fun (denom : Denomination.t) -> denom.h_pub = denom_hash) |> function | 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_signkey SignKeySignature.{ key; master_sig } = let open Syntax in let* signkey = Secmod_signkey.get_signkeys sm_signkey |> List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key) |> function | 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_signkey ~sm_denom MasterSignatures.{ denom_sigs; signkey_sigs } = let open Syntax in let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in Ok () (* --- *) let update_master_signatures ~db_conn ~sm_signkey ~sm_denom MasterSignatures.{ denom_sigs; signkey_sigs } = let open Syntax in let* () = signkey_sigs |> List.map (fun SignKeySignature.{ key; master_sig } -> (key, master_sig)) |> Secmod_signkey.add_master_signatures db_conn sm_signkey in let* () = denom_sigs |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } -> (* TODO better denomination-hash type *) let h_denom_pub = Bin_type.DenominationHash.of_octets (HashCode.to_octets h_denom_pub) in (h_denom_pub, master_sig)) |> Secmod_denom.add_master_signatures db_conn sm_denom 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 db_conn = Vif.Server.device Devices.db_connection server in 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* () = verify_master_signatures ~sm_signkey ~sm_denom master_signatures in let* () = update_master_signatures ~db_conn ~sm_signkey ~sm_denom master_signatures in Ok "" in respond_with_res res req