mte/src/management.ml

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 Bin_sig.DenominationKeyAnnouncement 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 Bin_sig.SigningKeyAnnouncement 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 Bin_sig.DenominationKeyValidity 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 Bin_sig.ExchangeSigningKeyValidity 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
  let* () =
    (* TODO move to test *)
    Secmod_denom.get_denoms sm_denom
    |> list_iter (fun denom ->
        let error = Error "update_master_signatures sanity check failure" in
        let* opt =
          Pg.lookup_denomination_key db_conn denom.Denomination.h_pub
          |> unwrap_err_caqti
        in
        let* ( valid_from,
               _expire_withdraw,
               _expire_deposit,
               _expire_legal,
               coin,
               _fee_withdraw,
               _fee_deposit,
               _fee_refresh,
               fee_refund,
               age_mask ) =
          match opt with None -> error | Some v -> Ok v
        in
        let check = function false -> error | true -> Ok () in
        (* TODO time *)
        let timestamp_equal a b =
          let timestamp_to_int64 = function
            | None -> None
            | Some v -> v |> Ptime.to_float_s |> Int64.of_float |> Option.some
          in
          timestamp_to_int64 a = timestamp_to_int64 b
        in
        let* () = check (timestamp_equal valid_from denom.stamp_start) in
        let* () = check (coin = denom.value) in
        let* () = check (fee_refund = denom.fee_refund) in
        let* () = check (age_mask = denom.age_mask) in
        Ok ())
  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 ->
      Logs.err (fun m -> m "%s." err);
      let err = Fmt.str "%s@." err in
      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