mte/src/management.ml

open Api
open Devices

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_denoms =
    sm_denom.keys
    |> List.filter (fun k -> Option.is_none k.Denomination.master_sig)
    |> List.map (fun denom ->
        mk_future_denom ~sm_denom_priv:sm_denom.sm_key.Signkey.priv denom)
  in
  let future_signkeys =
    sm_signkey.keys
    |> List.filter (fun k -> Option.is_none k.Signkey.master_sig)
    |> List.map (fun signkey ->
        mk_future_signkey ~sm_signkey_priv:sm_signkey.sm_key.Signkey.priv
          signkey)
  in
  let master_pub = Config.Exchange.master_public_key in
  let denom_secmod_public_key = sm_denom.sm_key.pub in
  let signkey_secmod_public_key = sm_signkey.sm_key.pub in
  FutureKeysResponse.
    {
      future_denoms;
      future_signkeys;
      master_pub;
      denom_secmod_public_key;
      signkey_secmod_public_key;
    }

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

(* - ** - *)

[@@@ocaml.warning "-27"]

let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig }
    =
  let open Syntax in
  let open Bin_type in
  let denom_hash =
    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_denom.Secmod_denom.keys
    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 Denomination.
        {
          pub= _;
          priv= _;
          section_name= _;
          value;
          stamp_start= start;
          stamp_expire_withdraw= expire_withdraw;
          stamp_expire_deposit= expire_spend;
          stamp_expire_legal= expire_legal;
          fee_withdraw;
          fee_deposit;
          fee_refresh;
          fee_refund= _;
          age_mask= _;
          h_pub= _;
          master_sig= _;
        } =
    denom
  in
  let master = Config.master_public_key in
  let open Api_sig.DenominationKeyValidityPS in
  let r : r =
    {
      master;
      start;
      expire_withdraw;
      expire_spend;
      expire_legal;
      value;
      fee_withdraw;
      fee_deposit;
      fee_refresh;
      denom_hash;
    }
  in
  verify ~key:master master_sig r

let verify_signkey_signature SignKeySignature.{ key; master_sig } = Ok ()
let verify_master_signatures ~sm_signkey ~sm_denom _ = Ok ()
let store_master_signatures _ = Ok ()

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 = Ok () in
    let* () =
      verify_master_signatures ~sm_signkey ~sm_denom master_signatures
    in
    let* () = store_master_signatures () in
    Ok ""
  in
  respond_with_res res req