add http_information.ml

src/http_information.ml

@@ -0,0 +1,279 @@
+open Syntax
+open Api
+module String_map = Stdlib.Map.Make (Stdlib.String)
+
+(* TODO mirage-crypto
+   is this ok?
+   maybe don't use the same RNG-initialization as the one used to generate keys *)
+let seed req _server _env =
+  Logs.info (fun m -> m "GET /seed");
+  (* RNG is initialized by Vif.run *)
+  let s = Mirage_crypto_rng.generate 64 in
+  let open Vif.Response in
+  let open Syntax in
+  let* () = add ~field:"content-type" "application/octet-stream" in
+  let* () = with_string req s in
+  respond `OK
+
+let config req _server _env =
+  Logs.info (fun m -> m "GET /config");
+  let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in
+  Respond_util.respond_with_ok_json s req
+
+(* TODO
+   for now we only have one item in each "denom group"
+   change this once we have denom/signkey rotation *)
+let denomgroup_of_denomdata
+    Denom_data.
+      {
+        pub;
+        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;
+        revoked_sig= _;
+      } =
+  let master_sig = match master_sig with None -> assert false | Some v -> v in
+  let denoms =
+    [
+      RsaDenom.
+        {
+          rsa_pub= pub;
+          master_sig;
+          stamp_start;
+          stamp_expire_withdraw;
+          stamp_expire_deposit;
+          stamp_expire_legal;
+          lost= None;
+        };
+    ]
+  in
+  DenomGroup.Rsa
+    RsaDenomGroup.
+      { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
+
+let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
+  let version = Api.protocol_version in
+  let base_url = Config.base_url in
+  let currency = Config.currency in
+  let shopping_url = Config.shopping_url in
+  let open_banking_gateway = Config.open_banking_gateway_url in
+  let bank_compliance_language = Config.bank_compliance_language in
+  let currency_specification =
+    let v = Config.Currency.v in
+    let alt_unit_names =
+      Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+    in
+    CurrencySpecification.
+      {
+        name= v.name;
+        num_fractional_input_digits= v.fractional_input_digits;
+        num_fractional_normal_digits= v.fractional_normal_digits;
+        num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits;
+        alt_unit_names;
+        common_amounts= [];
+      }
+  in
+  let tiny_amount = Config.tiny_amount in
+  let stefan_abs = Config.stefan_abs in
+  let stefan_log = Config.stefan_log in
+  let stefan_lin = Config.stefan_lin in
+  (* todo asset_type
+     Type of the asset. "fiat", "crypto", "regional" or "stock". *)
+  let asset_type = "xxx" in
+  let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in
+  let* wire_fees =
+    (* todo
+       where does wire_methods comes from? *)
+    let wire_method = "xxx" in
+    let+ wire_fees =
+      Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti
+    in
+    String_map.singleton wire_method wire_fees
+  in
+  let wads =
+    (* TODO wads *)
+    []
+  in
+  let rewards_allowed = false in
+  let kyc_enabled = false in
+  let disable_direct_deposit = (* todo *) false in
+  let master_public_key = Config.master_public_key in
+  let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in
+  (* todo *)
+  let wallet_balance_limit_without_kyc = None in
+  let hard_limits = [] in
+  let zero_limits = [] in
+  let denom_data_l =
+    (* TODO sm-db *)
+    (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
+    Sm.get_denoms_data ()
+  in
+  let denom_data_l =
+    (* reverse chronological order *)
+    List.sort
+      (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start)
+      denom_data_l
+  in
+  let list_issue_date =
+    match denom_data_l with
+    | [] -> Time.Timestamp.never
+    | v :: _ -> v.Denom_data.stamp_start
+  in
+  let denominations =
+    let open Denom_data in
+    (* if `?last_issue_date` query param does not exactly match the `stamp_start`
+       of one of the denomination keys, all keys are returned *)
+    let l =
+      match last_issue_date with
+      | None -> denom_data_l
+      | Some last_issue_date -> (
+          match
+            List.find_opt
+              (fun v ->
+                Time.Timestamp.compare v.stamp_start last_issue_date = 0)
+              denom_data_l
+          with
+          | None -> denom_data_l
+          | Some _ ->
+              List.filter
+                (fun v ->
+                  Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
+                denom_data_l)
+    in
+    List.map denomgroup_of_denomdata l
+  in
+
+  let signkeys =
+    (* TODO sm-db
+       use database signkey data / verify secmod and database are in sync *)
+    (*
+    let now = Ptime_clock.now () |> Option.some in
+    let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
+    let signkey_data_l = Sm.get_signkeys_data () in
+    let signkey_data_l =
+      List.sort
+        (fun a b ->
+          let open Signkey_data in
+          Stdlib.compare b.stamp_start a.stamp_start)
+        signkey_data_l
+    in
+    List.filter_map
+      (fun Signkey_data.
+             {
+               pub;
+               stamp_start;
+               stamp_expire;
+               stamp_end;
+               master_sig;
+               revoked_sig= _;
+             } ->
+        match master_sig with
+        | None -> None
+        | Some master_sig ->
+            Some
+              SignKey.
+                { key= pub; stamp_start; stamp_expire; stamp_end; master_sig })
+      signkey_data_l
+  in
+
+  let exchange_pub =
+    (* the eddsa pub key used to sign exchange_sig *)
+    match signkeys with
+    | [] -> Fmt.failwith "exchange has no active signkey"
+    | v :: _ -> v.SignKey.key
+  in
+  let exchange_sig =
+    (* Compact EdDSA signature (binary-only) over the
+       contatentation of all of the master_sigs (in reverse
+       chronological order by group) in the arrays under "denominations". *)
+    let hc =
+      denom_data_l
+      |> List.filter_map (fun v -> v.Denom_data.master_sig)
+      |> List.map Signatures.DenominationKeyValidity.to_octets
+      |> String.concat ""
+      |> Hash.H64.hash
+    in
+    let open Signatures.ExchangeKeySet in
+    sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc }
+  in
+
+  let recoup = (* TODO /recoup *) [] in
+  let* global_fees =
+    Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti
+  in
+  let* auditors =
+    (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *)
+    (* does not contains auditor_keys with empty denomination_keys *)
+    Pg.get_auditor_keys db_conn
+  in
+  let extensions = None in
+  let extensions_sig = None in
+  Ok
+    ExchangeKeysResponse.
+      {
+        version;
+        base_url;
+        currency;
+        shopping_url;
+        open_banking_gateway;
+        bank_compliance_language;
+        currency_specification;
+        tiny_amount;
+        stefan_abs;
+        stefan_log;
+        stefan_lin;
+        asset_type;
+        accounts;
+        wire_fees;
+        wads;
+        rewards_allowed;
+        kyc_enabled;
+        disable_direct_deposit;
+        master_public_key;
+        reserve_closing_delay;
+        wallet_balance_limit_without_kyc;
+        hard_limits;
+        zero_limits;
+        denominations;
+        exchange_sig;
+        exchange_pub;
+        recoup;
+        global_fees;
+        list_issue_date;
+        auditors;
+        signkeys;
+        extensions;
+        extensions_sig;
+      }
+
+let jsont = ExchangeKeysResponse.jsont
+
+let keys req server _env =
+  Logs.info (fun m -> m "GET /keys");
+  let db_conn = Vif.Server.device Devices.db_connection server in
+  let sm = Vif.Server.device Devices.secmod server in
+  let res =
+    let* last_issue_date =
+      match Vif.Queries.get req "last_issue_date" with
+      | [] -> Ok None
+      | v :: _ -> (
+          match int_of_string_opt v with
+          | None ->
+              Error
+                "invalid `?last_issue_date` query param, int_of_string failure"
+          | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n))))
+    in
+    let* v = mk_keys ~db_conn sm ~last_issue_date in
+    let s = Api.encode_exn jsont v in
+    Ok s
+  in
+  Respond_util.respond_with_res res req