diff --git a/.jjconflict-base-0/.gitignore b/.gitignore
similarity index 100%
rename from .jjconflict-base-0/.gitignore
rename to .gitignore
diff --git a/.jjconflict-base-0/src/http_management.ml b/.jjconflict-base-0/src/http_management.ml
deleted file mode 100644
index 54ea2557..00000000
--- a/.jjconflict-base-0/src/http_management.ml
+++ /dev/null
@@ -1,627 +0,0 @@
-open Syntax
-open Api
-open Hash
-
-module Keys_get = struct
- let mk_future_keys_response (module Keys : Keys.S) =
- let future_signkeys = Keys.get_future_signkeys () in
- let future_denoms = Keys.get_future_denominations () in
- let master_pub = Config.Exchange.master_public_key in
- let denom_secmod_public_key = Keys.sm_pubkey in
- let signkey_secmod_public_key = Keys.sm_pubkey in
- FutureKeysResponse.
- {
- future_denoms;
- future_signkeys;
- master_pub;
- denom_secmod_public_key;
- signkey_secmod_public_key;
- }
-
- let jsont = FutureKeysResponse.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "GET /management/keys/");
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let v = mk_future_keys_response sm in
- let s = Api.encode_exn jsont v in
- Ok s
- in
- Respond.result res req
-end
-
-module Keys_post = struct
- let error_key_unknown =
- "404 not found, One of the keys for which a signature was provided is \
- unknown to the exchange."
-
- let verify_denom_signature (module Keys : Keys.S)
- DenomSignature.{ h_denom_pub; master_sig } =
- let* denom =
- Keys.find_future_denomination h_denom_pub
- |> Option.to_result ~none:error_key_unknown
- in
- let open Signatures.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;
- fee_refund= denom.fee_refund;
- denom_hash= h_denom_pub;
- }
- in
- verify_f ~f:Keys.verify_with_master_key master_sig r
-
- let verify_signkey_signature (module Keys : Keys.S)
- SignKeySignature.{ key; master_sig } =
- let* signkey =
- Keys.find_future_signkey key |> Option.to_result ~none:error_key_unknown
- in
- let open Signatures.ExchangeSigningKeyValidity in
- let r : r =
- {
- start= signkey.stamp_start;
- expire= signkey.stamp_expire;
- end_= signkey.stamp_end;
- signkey_pub= signkey.key;
- }
- in
- verify_f ~f:Keys.verify_with_master_key master_sig r
-
- let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } =
- let* () = list_iter (verify_denom_signature sm) denom_sigs in
- let* () = list_iter (verify_signkey_signature sm) signkey_sigs in
- Ok ()
-
- let do_ ~db_conn:_ (module Keys : Keys.S)
- MasterSignatures.{ denom_sigs; signkey_sigs } =
- let* () =
- list_iter
- (fun SignKeySignature.{ key; master_sig } ->
- Keys.certify_future_signkey key ~master_sig)
- signkey_sigs
- in
- let* () =
- list_iter
- (fun DenomSignature.{ h_denom_pub; master_sig } ->
- Keys.certify_future_denomination h_denom_pub ~master_sig)
- denom_sigs
- in
- let* () = Keys.save () in
- Ok ()
-
- let jsont = MasterSignatures.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/keys/");
- let db_conn = Vif.Server.device Devices.db_connection server in
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn sm v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Denom_revoke = struct
- let verify (module Keys : Keys.S) h_denom_pub
- DenomRevocationSignature.{ master_sig } =
- let open Signatures.MasterDenominationKeyRevocation in
- verify_f ~f:Keys.verify_with_master_key master_sig { h_denom_pub }
-
- let do_ (module Keys : Keys.S) h_denom_pub
- DenomRevocationSignature.{ master_sig } =
- let+ () = Keys.revoke_denomination h_denom_pub master_sig in
- ()
-
- let jsont = DenomRevocationSignature.jsont
-
- let f req h_denom_pub server _env =
- Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm h_denom_pub v in
- let* () = do_ sm h_denom_pub v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Signkey_revoke = struct
- let verify (module Keys : Keys.S) exchange_pub
- SignkeyRevocationSignature.{ master_sig } =
- let open Signatures.MasterSigningKeyRevocation in
- verify_f ~f:Keys.verify_with_master_key master_sig { exchange_pub }
-
- let do_ (module Keys : Keys.S) exchange_pub
- SignkeyRevocationSignature.{ master_sig } =
- let+ () = Keys.revoke_signkey exchange_pub master_sig in
- ()
-
- let jsont = SignkeyRevocationSignature.jsont
-
- let f req exchange_pub server _env =
- Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm exchange_pub v in
- let* () = do_ sm exchange_pub v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Auditors = struct
- let verify (module Keys : Keys.S)
- AuditorSetupMessage.
- {
- auditor_url;
- auditor_name= _;
- auditor_pub;
- master_sig;
- validity_start;
- } =
- let open Signatures.MasterAddAuditor in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- start_date= validity_start;
- auditor_pub;
- h_auditor_url= Hash.Cstring.H64.hash auditor_url;
- }
-
- (* TODO monotonic time *)
- let do_ ~db_conn v =
- let auditor_pub = v.AuditorSetupMessage.auditor_pub in
- let validity_start = v.AuditorSetupMessage.validity_start in
- let* last_date_opt =
- Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
- in
- match last_date_opt with
- | None ->
- let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "enabled auditor");
- ()
- | Some last_date ->
- if Timestamp.compare last_date validity_start > 0 then
- Error
- "database has more recent auditor data for this auditor public key"
- else
- let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "updated auditor");
- ()
-
- let jsont = AuditorSetupMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/auditors/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Auditors_disable = struct
- let verify (module Keys : Keys.S) auditor_pub
- AuditorTeardownMessage.{ master_sig; validity_end } =
- let open Signatures.MasterDelAuditor in
- verify_f ~f:Keys.verify_with_master_key master_sig
- { end_date= validity_end; auditor_pub }
-
- let do_ ~db_conn auditor_pub
- AuditorTeardownMessage.{ master_sig= _; validity_end } =
- let* last_date_opt =
- Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
- in
- match last_date_opt with
- | None -> Error "auditor not found"
- | Some last_date ->
- if Timestamp.compare last_date validity_end > 0 then
- Error
- "database has more recent auditor data for this auditor public key"
- else
- let+ () =
- Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
- |> unwrap_err_caqti
- in
- ()
-
- let jsont = AuditorTeardownMessage.jsont
-
- let f req auditor_pub server _env =
- Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm auditor_pub v in
- let* () = do_ ~db_conn auditor_pub v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Wire_fee = struct
- let verify (module Keys : Keys.S)
- WireFeeSetupMessage.
- {
- wire_method;
- master_sig_wire;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- } =
- let open Signatures.MasterWireFee in
- verify_f ~f:Keys.verify_with_master_key master_sig_wire
- {
- h_wire_method= Hash.Cstring.H64.hash wire_method;
- start_date= fee_start;
- end_date= fee_end;
- wire_fee;
- closing_fee;
- }
-
- let do_ ~db_conn (v : WireFeeSetupMessage.t) =
- let* wire_fees =
- Pg.get_wire_fees_by_time db_conn ~wire_method:v.wire_method
- ~start_date:v.fee_start ~end_date:v.fee_end
- |> unwrap_err_caqti
- in
- match wire_fees with
- | [] ->
- let+ () = Pg.insert_wire_fee db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "added wire fee");
- ()
- | [ vv ] -> (
- match v.master_sig_wire = vv.sig_ with
- | false ->
- Error "a different wire-fee was already setup for this time frame"
- | true ->
- Logs.info (fun m -> m "an identical wire-fee was already setup");
- Ok ())
- | _ ->
- Error
- "invalid database state, multiple wire-fee found in database for \
- this time frame"
-
- let jsont = WireFeeSetupMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/wire-fee/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Global_fees = struct
- let verify (module Keys : Keys.S)
- GlobalFees.
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- } =
- let open Signatures.GlobalFees in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- }
-
- let do_ ~db_conn v =
- let* global_fees =
- let start_date = v.GlobalFees.start_date in
- let end_date = v.GlobalFees.end_date in
- Pg.get_global_fees_by_time db_conn ~start_date ~end_date
- |> unwrap_err_caqti
- in
- match global_fees with
- | [] ->
- let+ () = Pg.insert_global_fees db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "added global fees");
- ()
- | [ vv ] -> (
- match v.master_sig = vv.master_sig with
- | false ->
- Error
- "a different global-fees was already setup for this time frame"
- | true ->
- Logs.info (fun m -> m "an identical global-fees was already setup");
- Ok ())
- | _ ->
- Error
- "invalid database state, multiple global-fees found in database for \
- this time frame"
-
- let jsont = GlobalFees.jsont
-
- (* TODO better global_fees
- ensure it is defined for the current time.
- there should be only one global_fees for each moment in time
- and once set for a timeframe, it should not change. *)
- let f req server _env =
- Logs.info (fun m -> m "POST /management/global-fees/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Wire = struct
- let verify (module Keys : Keys.S)
- WireSetupMessage.
- {
- payto_uri;
- master_sig_wire;
- master_sig_add;
- validity_start;
- bank_label= _;
- priority= _;
- } =
- (* TODO are those read from payto_uri? *)
- let conversion_url = "" in
- let credit_restrictions = "" in
- let debit_restrictions = "" in
- let* () =
- let open Signatures.MasterWireDetails in
- verify_f ~f:Keys.verify_with_master_key master_sig_wire
- {
- h_wire_details= FullPaytoHash.hash payto_uri;
- h_conversion_url= Hash.Cstring.H64.hash conversion_url;
- h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
- h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
- }
- in
- let* () =
- let open Signatures.MasterAddWire in
- verify_f ~f:Keys.verify_with_master_key master_sig_add
- {
- start_date= validity_start;
- h_wire= FullPaytoHash.hash payto_uri;
- h_conversion_url= Hash.Cstring.H64.hash conversion_url;
- h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
- h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
- }
- in
- Ok ()
-
- let do_ ~db_conn v =
- let* last_change_opt =
- let payto_uri = v.WireSetupMessage.payto_uri in
- Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
- in
- match last_change_opt with
- | Some _ -> Error "wire already setup"
- | None ->
- let r =
- ExchangeWireAccount.
- {
- payto_uri= v.payto_uri;
- conversion_url= None;
- debit_restrictions= [];
- credit_restrictions= [];
- master_sig= v.master_sig_wire;
- bank_label= v.bank_label;
- priority= v.priority;
- }
- in
- let+ () =
- Pg.insert_wire db_conn ~last_change:v.validity_start r
- |> unwrap_err_caqti
- in
- ()
-
- let jsont = WireSetupMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/wire/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Wire_disable = struct
- let verify (module Keys : Keys.S)
- WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
- let open Signatures.MasterDelWire in
- verify_f ~f:Keys.verify_with_master_key master_sig_del
- { end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri }
-
- let do_ ~db_conn
- WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
- let* last_change_opt =
- Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
- in
- match last_change_opt with
- | None -> Error "wire not found"
- | Some _ ->
- let+ () =
- Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
- in
- ()
-
- let jsont = WireTeardownMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/wire/disable/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Drain = struct
- let verify (module Keys : Keys.S)
- DrainProfitsMessage.
- {
- debit_account_section;
- credit_payto_uri;
- wtid;
- master_sig;
- date;
- amount;
- } =
- let open Signatures.MasterDrainProfit in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- wtid;
- date;
- amount;
- h_section= Hash.Cstring.H64.hash debit_account_section;
- h_payto= FullPaytoHash.hash credit_payto_uri;
- }
-
- let do_ ~db_conn v =
- let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
- ()
-
- let jsont = DrainProfitsMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/drain/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module AmlOfficer = struct
- let verify (module Keys : Keys.S)
- AmlOfficerSetup.
- {
- officer_pub;
- officer_name;
- is_active;
- read_only= _;
- master_sig;
- change_date;
- } =
- let open Signatures.MasterAmlOfficerStatus in
- let is_active = match is_active with true -> 1_l | false -> 0_l in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- change_date;
- officer_pub;
- h_officer_name= Hash.Cstring.H64.hash officer_name;
- is_active;
- }
-
- let do_ ~db_conn v =
- let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_err_caqti in
- ()
-
- let jsont = AmlOfficerSetup.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/aml-officers/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Partners = struct
- let verify (module Keys : Keys.S)
- ExchangePartnerSetupRequest.
- {
- partner_base_url;
- partner_pub;
- wad_frequency;
- master_sig;
- start_date;
- end_date;
- wad_fee;
- } =
- let open Signatures.PartnerConfiguration in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- partner_pub;
- start_date;
- end_date;
- wad_frequency;
- wad_fee;
- h_url= Hash.Cstring.H64.hash partner_base_url;
- }
-
- let do_ ~db_conn v =
- let+ () = Pg.insert_partner db_conn v |> unwrap_err_caqti in
- ()
-
- let jsont = ExchangePartnerSetupRequest.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/partners/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
diff --git a/.jjconflict-base-0/src/keys.ml b/.jjconflict-base-0/src/keys.ml
deleted file mode 100644
index 44532ccb..00000000
--- a/.jjconflict-base-0/src/keys.ml
+++ /dev/null
@@ -1,476 +0,0 @@
-module type S = sig
- open Crypto
-
- val sm_pubkey : eddsa_pub
- val sign_with_sm_key : string -> eddsa_sig
- val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
- val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
- val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
-
- val verify_with_signkey :
- pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
-
- val get_signkeys : unit -> Signkey.t list
- val get_denominations : unit -> Denomination.t list
- val get_future_signkeys : unit -> Api.FutureSignKey.t list
- val get_future_denominations : unit -> Api.FutureDenom.t list
- val find_signkey : eddsa_pub -> Signkey.t option
- val find_denomination : denom_hash -> Denomination.t option
- val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
- val find_future_denomination : denom_hash -> Api.FutureDenom.t option
-
- val certify_future_signkey :
- eddsa_pub ->
- master_sig:Signatures.ExchangeSigningKeyValidity.t ->
- (unit, string) result
-
- val certify_future_denomination :
- denom_hash ->
- master_sig:Signatures.DenominationKeyValidity.t ->
- (unit, string) result
-
- val revoke_signkey :
- eddsa_pub ->
- Signatures.MasterSigningKeyRevocation.t ->
- (unit, string) result
-
- val revoke_denomination :
- denom_hash ->
- Signatures.MasterDenominationKeyRevocation.t ->
- (unit, string) result
-
- val save : unit -> (unit, string) result
-end
-
-module Make (Conn : Pg.CONN) = struct
- open Syntax
- open Crypto
- module DenominationHash = Hash.DenominationHash
-
- let read fname = Bos.OS.File.read fname |> unwrap_err_msg
- let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
- let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
- let write_rsa fname priv = write fname (RsaPrivateKey.to_octets priv)
-
- let read_eddsa fname =
- let* data = read fname in
- EddsaPrivateKey.of_octets data
-
- let read_rsa fname =
- let* data = read fname in
- RsaPrivateKey.of_octets data
-
- type sk = Signkey.t
- type future_sk = Api.FutureSignKey.t
- type dn = Denomination.t
- type future_dn = Api.FutureDenom.t
-
- (* TODO ! use lock *)
- (* not sure what to do with coin section_name, rm if possible *)
- type t = {
- sm_key: eddsa_priv;
- sm_pubkey: eddsa_pub;
- sk_ht: (eddsa_pub, sk) Hashtbl.t;
- dn_ht: (denom_hash, dn) Hashtbl.t;
- sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
- dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
- future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t;
- future_dn_ht: (denom_hash, future_dn) Hashtbl.t;
- future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
- future_dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
- dn_section_name_ht: (denom_hash, string) Hashtbl.t;
- }
-
- let conn = (module Conn : Pg.CONN)
- let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key")
- let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i)
-
- let dn_fname section_name =
- Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name)
-
- let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s
-
- let make_future_sk t =
- let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
- let expire =
- Time.Absolute.add start Config.Exchange.signkey_legal_duration
- in
- let stamp_start = Timestamp.of_absolute start in
- let stamp_expire = Timestamp.of_absolute expire in
- let stamp_end = stamp_expire in
- let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
- let signkey_secmod_sig =
- let open Signatures.SigningKeyAnnouncement in
- let exchange_pub = pub in
- let anchor_time = stamp_start in
- let duration = Timestamp.diff stamp_start stamp_expire in
- sign_f ~f:(sign_with_sm_key t) { exchange_pub; anchor_time; duration }
- in
- let future_sk =
- Api.FutureSignKey.
- { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
- in
- Hashtbl.replace t.future_sk_ht pub future_sk;
- Hashtbl.replace t.future_sk_key_ht pub priv;
- ()
-
- let make_future_dn t
- Config.Coin.
- {
- section_name;
- value;
- duration_withdraw;
- duration_spend;
- duration_legal;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- cipher;
- rsa_keysize;
- age_restricted= _;
- } =
- assert (cipher = `RSA);
- let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
- let stamp_start = Timestamp.of_absolute start in
- let stamp_expire_withdraw =
- Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
- in
- let stamp_expire_deposit =
- Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
- in
- let stamp_expire_legal =
- Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
- in
- let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in
- let open Api in
- let rsa_denomination_key =
- RsaDenominationKey.{ age_mask= 0; rsa_pub= pub }
- in
- let denom_pub = DenominationKey.Rsa rsa_denomination_key in
- let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
- let denom_secmod_sig =
- let open Signatures.DenominationKeyAnnouncement in
- let h_denom_pub = h_pub in
- let h_section_name = Hash.Cstring.H64.hash section_name in
- let anchor_time = stamp_start in
- let duration_withdraw =
- Timestamp.diff stamp_start stamp_expire_withdraw
- in
- sign_f ~f:(sign_with_sm_key t)
- { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
- in
- let future_dn =
- 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;
- }
- in
- Hashtbl.replace t.future_dn_ht h_pub future_dn;
- Hashtbl.replace t.future_dn_key_ht h_pub priv;
- ()
-
- let make_new () =
- let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in
- let t =
- {
- sm_key;
- sm_pubkey;
- sk_ht= Hashtbl.create 0xff;
- dn_ht= Hashtbl.create 0xff;
- sk_key_ht= Hashtbl.create 0xff;
- dn_key_ht= Hashtbl.create 0xff;
- future_sk_ht= Hashtbl.create 0xff;
- future_dn_ht= Hashtbl.create 0xff;
- future_sk_key_ht= Hashtbl.create 0xff;
- future_dn_key_ht= Hashtbl.create 0xff;
- dn_section_name_ht= Hashtbl.create 0xff;
- }
- in
- make_future_sk t;
- List.iter (make_future_dn t) Config.Coin.all_coins;
- t
-
- let database_find_sk conn pub =
- let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
- match opt with
- | None -> Fmt.error "Keys: signkey data not found in database"
- | Some sk_data -> Ok sk_data
-
- let database_find_dn conn h_pub =
- let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
- match opt with
- | None -> Fmt.error "Keys: denomination data not found in database"
- | Some dn_data -> Ok dn_data
-
- let list_to_ht l = Hashtbl.of_seq (List.to_seq l)
-
- let load () =
- let* sm_key = read_eddsa sm_key_fname in
- let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
-
- let* sk_keys = list_map read_eddsa (List.init 1 sk_fname) in
- let* sk_l =
- list_map
- (fun priv ->
- let pub = EddsaPrivateKey.pub_of_priv priv in
- let+ sk = database_find_sk conn pub in
- ((pub, sk), (pub, priv)))
- sk_keys
- in
- let sk_ht, sk_key_ht =
- match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
- in
-
- let dn_section_name_ht = Hashtbl.create 0xff in
- let* dn_keys =
- list_map
- (fun coin ->
- let section_name = coin.Config.Coin.section_name in
- let+ priv = read_rsa (dn_fname section_name) in
- (section_name, priv))
- Config.Coin.all_coins
- in
- let* dn_l =
- list_map
- (fun (section_name, priv) ->
- let h_pub =
- priv
- |> RsaPrivateKey.pub_of_priv
- |> RsaPublicKey.to_octets
- |> DenominationHash.hash
- in
- (* fill dn_section_name_ht *)
- Hashtbl.replace dn_section_name_ht h_pub section_name;
- let+ dn = database_find_dn conn h_pub in
- ((h_pub, dn), (h_pub, priv)))
- dn_keys
- in
- let dn_ht, dn_key_ht =
- match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
- in
- (* future keys are not stored anywhere until they are certified with a master_sig
- so we don't have any future key to load *)
- let t =
- {
- sm_key;
- sm_pubkey;
- sk_ht;
- dn_ht;
- sk_key_ht;
- dn_key_ht;
- future_sk_ht= Hashtbl.create 0xff;
- future_dn_ht= Hashtbl.create 0xff;
- future_sk_key_ht= Hashtbl.create 0xff;
- future_dn_key_ht= Hashtbl.create 0xff;
- dn_section_name_ht;
- }
- in
- Ok t
-
- let init () =
- let dir = Config.secmod_dir in
- let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
- if b then Logs.info (fun m -> m "Keys: created directory `%a`" Fpath.pp dir);
- let* l =
- Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
- in
- match List.is_empty l with
- | true ->
- Logs.info (fun m -> m "Keys: empty storage, generating fresh keys");
- let t = make_new () in
- Ok t
- | false ->
- Logs.info (fun m -> m "Keys: loading keys from storage");
- load ()
-
- let t =
- match init () with
- | Error e -> Fmt.failwith "Keys: initialization failure: `%s`." e
- | Ok t ->
- Logs.info (fun m -> m "Keys: initialized");
- t
-
- let sm_pubkey = t.sm_pubkey
- let sign_with_sm_key s = sign_with_sm_key t s
-
- let sign_with_signkey ~pub s =
- match Hashtbl.find_opt t.sk_key_ht pub with
- | None -> Fmt.failwith "Keys sign_with_signkey failure: not found."
- | Some priv -> EddsaSignature.sign ~key:priv s
-
- let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_pubkey s ~msg
-
- let verify_with_master_key =
- EddsaSignature.verify ~key:Config.master_public_key
-
- let verify_with_signkey ~pub s ~msg =
- match Hashtbl.find_opt t.sk_ht pub with
- | None -> Fmt.failwith "Keys verify_with_signkey failure: not found."
- | Some _sk -> EddsaSignature.verify ~key:pub s ~msg
-
- let get_signkeys () = t.sk_ht |> Hashtbl.to_seq_values |> List.of_seq
- let get_denominations () = t.dn_ht |> Hashtbl.to_seq_values |> List.of_seq
-
- let get_future_signkeys () =
- t.future_sk_ht |> Hashtbl.to_seq_values |> List.of_seq
-
- let get_future_denominations () =
- t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq
-
- let find_signkey pub = Hashtbl.find_opt t.sk_ht pub
- let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub
- let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub
- let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_pub
-
- let certify_future_signkey pub ~master_sig =
- match
- ( Hashtbl.find_opt t.future_sk_ht pub,
- Hashtbl.find_opt t.future_sk_key_ht pub )
- with
- | None, _ | _, None ->
- Error "Keys certify_future_signkey: future signkey not found."
- | Some future_sk, Some priv -> (
- match Hashtbl.find_opt t.sk_ht pub with
- | Some _sk -> Error "Keys certify_future_signkey: already certified"
- | None ->
- let Api.FutureSignKey.
- {
- key;
- stamp_start;
- stamp_expire;
- stamp_end;
- signkey_secmod_sig= _;
- } =
- future_sk
- in
- let sk =
- Signkey.
- {
- pub= key;
- stamp_start;
- stamp_expire;
- stamp_end;
- master_sig;
- revoked_sig= None;
- }
- in
- Hashtbl.replace t.sk_ht pub sk;
- Hashtbl.replace t.sk_key_ht pub priv;
- Hashtbl.remove t.future_sk_ht pub;
- Hashtbl.remove t.future_sk_key_ht pub;
-
- let* () = Pg.insert_signkey (module Conn) sk |> unwrap_err_caqti in
- Ok ())
-
- let certify_future_denomination h_pub ~master_sig =
- match
- ( Hashtbl.find_opt t.future_dn_ht h_pub,
- Hashtbl.find_opt t.future_dn_key_ht h_pub )
- with
- | None, _ | _, None ->
- Error "Keys certify_future_denomination: future denomination not found."
- | Some future_dn, Some priv -> (
- match Hashtbl.find_opt t.dn_ht h_pub with
- | Some _dn ->
- Error "Keys certify_future_denomination: already certified"
- | None ->
- let Api.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= _;
- } =
- future_dn
- in
- let rsa_pub =
- match denom_pub with
- | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
- in
- let dn =
- Denomination.
- {
- pub= rsa_pub;
- value;
- stamp_start;
- stamp_expire_withdraw;
- stamp_expire_deposit;
- stamp_expire_legal;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- age_mask= 0;
- h_pub;
- master_sig;
- revoked_sig= None;
- }
- in
- Hashtbl.replace t.dn_ht h_pub dn;
- Hashtbl.replace t.dn_key_ht h_pub priv;
- Hashtbl.replace t.dn_section_name_ht h_pub section_name;
- Hashtbl.remove t.future_dn_ht h_pub;
- Hashtbl.remove t.future_dn_key_ht h_pub;
-
- let* () = Pg.insert_denom (module Conn) dn |> unwrap_err_caqti in
- Ok ())
-
- let revoke_signkey pub revoked_sig =
- match Hashtbl.find_opt t.sk_ht pub with
- | None -> Error "Keys revoke_signkey: signkey not found."
- | Some sk ->
- let sk = { sk with revoked_sig= Some revoked_sig } in
- Hashtbl.replace t.sk_ht pub sk;
-
- (* TODO revoke, apply to database *)
- Ok ()
-
- let revoke_denomination pub revoked_sig =
- match Hashtbl.find_opt t.dn_ht pub with
- | None -> Error "Keys revoke_denomination: denomination not found."
- | Some dn ->
- let dn = { dn with revoked_sig= Some revoked_sig } in
- Hashtbl.replace t.dn_ht pub dn;
-
- (* TODO revoke, apply to database *)
- Ok ()
-
- let save () =
- let* () = write_eddsa sm_key_fname t.sm_key in
- let* () =
- Hashtbl.to_seq_values t.sk_key_ht
- |> List.of_seq
- |> List.mapi (fun i priv -> write_eddsa (sk_fname i) priv)
- |> list_iter Fun.id
- in
- let* () =
- Hashtbl.to_seq t.dn_key_ht
- |> List.of_seq
- |> list_iter (fun (h_pub, priv) ->
- match Hashtbl.find_opt t.dn_section_name_ht h_pub with
- | None -> Error "Keys save: invalid state, section_name not found"
- | Some section_name -> write_rsa (dn_fname section_name) priv)
- in
- Logs.info (fun m -> m "saved private keys data");
- Ok ()
-end
diff --git a/.jjconflict-side-0/.gitignore b/.jjconflict-side-0/.gitignore
deleted file mode 100644
index 7aeab444..00000000
--- a/.jjconflict-side-0/.gitignore
+++ /dev/null
@@ -1,5 +0,0 @@
-_build
-_taler_exchange_sql
-assets
-secrets
-!secrets/.keep
diff --git a/.jjconflict-side-0/.ocamlformat b/.jjconflict-side-0/.ocamlformat
deleted file mode 100644
index 43b12fc0..00000000
--- a/.jjconflict-side-0/.ocamlformat
+++ /dev/null
@@ -1,15 +0,0 @@
-version=0.28.1
-exp-grouping=preserve
-type-decl=sparse
-break-infix=fit-or-vertical
-break-collection-expressions=fit-or-vertical
-break-sequences=false
-break-infix-before-func=false
-dock-collection-brackets=true
-break-separators=after
-field-space=tight
-if-then-else=compact
-break-sequences=false
-sequence-blank-line=compact
-exp-grouping=preserve
-sequence-blank-line=preserve-one
diff --git a/.jjconflict-side-0/LICENSE b/.jjconflict-side-0/LICENSE
deleted file mode 100644
index be3f7b28..00000000
--- a/.jjconflict-side-0/LICENSE
+++ /dev/null
@@ -1,661 +0,0 @@
- GNU AFFERO GENERAL PUBLIC LICENSE
- Version 3, 19 November 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc.
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The GNU Affero General Public License is a free, copyleft license for
-software and other kinds of works, specifically designed to ensure
-cooperation with the community in the case of network server software.
-
- The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works. By contrast,
-our General Public Licenses are intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
- Developers that use our General Public Licenses protect your rights
-with two steps: (1) assert copyright on the software, and (2) offer
-you this License which gives you legal permission to copy, distribute
-and/or modify the software.
-
- A secondary benefit of defending all users' freedom is that
-improvements made in alternate versions of the program, if they
-receive widespread use, become available for other developers to
-incorporate. Many developers of free software are heartened and
-encouraged by the resulting cooperation. However, in the case of
-software used on network servers, this result may fail to come about.
-The GNU General Public License permits making a modified version and
-letting the public access it on a server without ever releasing its
-source code to the public.
-
- The GNU Affero General Public License is designed specifically to
-ensure that, in such cases, the modified source code becomes available
-to the community. It requires the operator of a network server to
-provide the source code of the modified version running there to the
-users of that server. Therefore, public use of a modified version, on
-a publicly accessible server, gives the public access to the source
-code of the modified version.
-
- An older license, called the Affero General Public License and
-published by Affero, was designed to accomplish similar goals. This is
-a different license, not a version of the Affero GPL, but Affero has
-released a new version of the Affero GPL which permits relicensing under
-this license.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- TERMS AND CONDITIONS
-
- 0. Definitions.
-
- "This License" refers to version 3 of the GNU Affero General Public License.
-
- "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
- "The Program" refers to any copyrightable work licensed under this
-License. Each licensee is addressed as "you". "Licensees" and
-"recipients" may be individuals or organizations.
-
- To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy. The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
- A "covered work" means either the unmodified Program or a work based
-on the Program.
-
- To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy. Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
- To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies. Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
- An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License. If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
- 1. Source Code.
-
- The "source code" for a work means the preferred form of the work
-for making modifications to it. "Object code" means any non-source
-form of a work.
-
- A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
- The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form. A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
- The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities. However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work. For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
- The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
- The Corresponding Source for a work in source code form is that
-same work.
-
- 2. Basic Permissions.
-
- All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met. This License explicitly affirms your unlimited
-permission to run the unmodified Program. The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work. This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
- You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force. You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright. Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
- Conveying under any other circumstances is permitted solely under
-the conditions stated below. Sublicensing is not allowed; section 10
-makes it unnecessary.
-
- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
- No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
- When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
- 4. Conveying Verbatim Copies.
-
- You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
- You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
- 5. Conveying Modified Source Versions.
-
- You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
- a) The work must carry prominent notices stating that you modified
- it, and giving a relevant date.
-
- b) The work must carry prominent notices stating that it is
- released under this License and any conditions added under section
- 7. This requirement modifies the requirement in section 4 to
- "keep intact all notices".
-
- c) You must license the entire work, as a whole, under this
- License to anyone who comes into possession of a copy. This
- License will therefore apply, along with any applicable section 7
- additional terms, to the whole of the work, and all its parts,
- regardless of how they are packaged. This License gives no
- permission to license the work in any other way, but it does not
- invalidate such permission if you have separately received it.
-
- d) If the work has interactive user interfaces, each must display
- Appropriate Legal Notices; however, if the Program has interactive
- interfaces that do not display Appropriate Legal Notices, your
- work need not make them do so.
-
- A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit. Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
- 6. Conveying Non-Source Forms.
-
- You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
- a) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by the
- Corresponding Source fixed on a durable physical medium
- customarily used for software interchange.
-
- b) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by a
- written offer, valid for at least three years and valid for as
- long as you offer spare parts or customer support for that product
- model, to give anyone who possesses the object code either (1) a
- copy of the Corresponding Source for all the software in the
- product that is covered by this License, on a durable physical
- medium customarily used for software interchange, for a price no
- more than your reasonable cost of physically performing this
- conveying of source, or (2) access to copy the
- Corresponding Source from a network server at no charge.
-
- c) Convey individual copies of the object code with a copy of the
- written offer to provide the Corresponding Source. This
- alternative is allowed only occasionally and noncommercially, and
- only if you received the object code with such an offer, in accord
- with subsection 6b.
-
- d) Convey the object code by offering access from a designated
- place (gratis or for a charge), and offer equivalent access to the
- Corresponding Source in the same way through the same place at no
- further charge. You need not require recipients to copy the
- Corresponding Source along with the object code. If the place to
- copy the object code is a network server, the Corresponding Source
- may be on a different server (operated by you or a third party)
- that supports equivalent copying facilities, provided you maintain
- clear directions next to the object code saying where to find the
- Corresponding Source. Regardless of what server hosts the
- Corresponding Source, you remain obligated to ensure that it is
- available for as long as needed to satisfy these requirements.
-
- e) Convey the object code using peer-to-peer transmission, provided
- you inform other peers where the object code and Corresponding
- Source of the work are being offered to the general public at no
- charge under subsection 6d.
-
- A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
- A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling. In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage. For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product. A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
- "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source. The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
- If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information. But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
- The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed. Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
- Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
- 7. Additional Terms.
-
- "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law. If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
- When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it. (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.) You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
- Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
- a) Disclaiming warranty or limiting liability differently from the
- terms of sections 15 and 16 of this License; or
-
- b) Requiring preservation of specified reasonable legal notices or
- author attributions in that material or in the Appropriate Legal
- Notices displayed by works containing it; or
-
- c) Prohibiting misrepresentation of the origin of that material, or
- requiring that modified versions of such material be marked in
- reasonable ways as different from the original version; or
-
- d) Limiting the use for publicity purposes of names of licensors or
- authors of the material; or
-
- e) Declining to grant rights under trademark law for use of some
- trade names, trademarks, or service marks; or
-
- f) Requiring indemnification of licensors and authors of that
- material by anyone who conveys the material (or modified versions of
- it) with contractual assumptions of liability to the recipient, for
- any liability that these contractual assumptions directly impose on
- those licensors and authors.
-
- All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10. If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term. If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
- If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
- Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
- 8. Termination.
-
- You may not propagate or modify a covered work except as expressly
-provided under this License. Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
- However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
- Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
- Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
- 9. Acceptance Not Required for Having Copies.
-
- You are not required to accept this License in order to receive or
-run a copy of the Program. Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance. However,
-nothing other than this License grants you permission to propagate or
-modify any covered work. These actions infringe copyright if you do
-not accept this License. Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
- 10. Automatic Licensing of Downstream Recipients.
-
- Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License. You are not responsible
-for enforcing compliance by third parties with this License.
-
- An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations. If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
- You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License. For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
- 11. Patents.
-
- A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based. The
-work thus licensed is called the contributor's "contributor version".
-
- A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version. For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
- Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
- In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement). To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
- If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients. "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
- If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
- A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License. You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
- Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
- 12. No Surrender of Others' Freedom.
-
- If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all. For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
- 13. Remote Network Interaction; Use with the GNU General Public License.
-
- Notwithstanding any other provision of this License, if you modify the
-Program, your modified version must prominently offer all users
-interacting with it remotely through a computer network (if your version
-supports such interaction) an opportunity to receive the Corresponding
-Source of your version by providing access to the Corresponding Source
-from a network server at no charge, through some standard or customary
-means of facilitating copying of software. This Corresponding Source
-shall include the Corresponding Source for any work covered by version 3
-of the GNU General Public License that is incorporated pursuant to the
-following paragraph.
-
- Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU General Public License into a single
-combined work, and to convey the resulting work. The terms of this
-License will continue to apply to the part which is the covered work,
-but the work with which it is combined will remain governed by version
-3 of the GNU General Public License.
-
- 14. Revised Versions of this License.
-
- The Free Software Foundation may publish revised and/or new versions of
-the GNU Affero General Public License from time to time. Such new versions
-will be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Program specifies that a certain numbered version of the GNU Affero General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation. If the Program does not specify a version number of the
-GNU Affero General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
- If the Program specifies that a proxy can decide which future
-versions of the GNU Affero General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
- Later license versions may give you additional or different
-permissions. However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
- 15. Disclaimer of Warranty.
-
- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. Limitation of Liability.
-
- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
- 17. Interpretation of Sections 15 and 16.
-
- If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-
- Copyright (C)
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU Affero General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Affero General Public License for more details.
-
- You should have received a copy of the GNU Affero General Public License
- along with this program. If not, see .
-
-Also add information on how to contact you by electronic and paper mail.
-
- If your software can interact with users remotely through a computer
-network, you should also make sure that it provides a way for users to
-get its source. For example, if your program is a web application, its
-interface could display a "Source" link that leads users to an archive
-of the code. There are many ways you could offer source, and different
-solutions will be better for different programs; see section 13 for the
-specific requirements.
-
- You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU AGPL, see
-.
diff --git a/.jjconflict-side-0/default/assets/mte.conf b/.jjconflict-side-0/default/assets/mte.conf
deleted file mode 100644
index a6c89c52..00000000
--- a/.jjconflict-side-0/default/assets/mte.conf
+++ /dev/null
@@ -1,74 +0,0 @@
-[currency-EUR]
-enabled= YES
-code= EUR
-name= euro
-fractional_input_digits= 2
-fractional_normal_digits= 2
-fractional_trailing_zero_digits= 2
-alt_unit_names= "{"0":"€","3":"k€"}"
-
-[exchange]
-currency = EUR
-currency_round_unit = EUR:0.01
-db = postgres
-attribute_encryption_key = "deadbeef"
-port = 3434
-bind_to = localhost
-master_public_key = "SJ0NYND22VQP3MP7FM754RDX8HCKVWAXTHY9SQNBTPRJZ2SPM2S0"
-stefan_abs = EUR:0.00
-stefan_log = EUR:0.00
-stefan_lin = 0.00
-aggregator_idle_sleep_interval = "1 hour"
-closer_idle_sleep_interval = "1 hour"
-transfer_idle_sleep_interval = "1 hour"
-wirewatch_idle_sleep_interval = "1 hour"
-signkey_legal_duration = "1 year"
-max_keys_caching = "4 weeks"
-enable_kyc = NO
-terms_etag = "0"
-privacy_etag = "0"
-base_url = "http://localhost:3434/"
-
-[exchangedb]
-idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds"
-legal_reserve_expiration_time = "1 year"
-aggregator_shift = "1 year"
-max_aml_program_runtime = "1 year"
-default_purse_limit = 9999
-
-[exchangedb-postgres]
-config = "pgx://mte:hunter2@localhost:5432/taler-exchange"
-
-[taler-exchange-secmod-rsa]
-lookahead_sign = "1 year"
-overlap_duration = "1 year"
-
-[taler-exchange-secmod-eddsa]
-lookahead_sign = "1 year"
-overlap_duration = "1 year"
-
-[coin_kudo_1]
-value= EUR:0.01
-duration_withdraw= "1 year"
-duration_spend= "1 year"
-duration_legal= "1 year"
-fee_withdraw= EUR:0.00
-fee_deposit= EUR:0.00
-fee_refresh= EUR:0.00
-fee_refund= EUR:0.00
-cipher= RSA
-rsa_keysize= 2048
-age_restricted= NO
-
-[coin_kudo_2]
-value= EUR:0.02
-duration_withdraw= "1 year"
-duration_spend= "1 year"
-duration_legal= "1 year"
-fee_withdraw= EUR:0.00
-fee_deposit= EUR:0.00
-fee_refresh= EUR:0.00
-fee_refund= EUR:0.00
-cipher= RSA
-rsa_keysize= 2048
-age_restricted= NO
diff --git a/.jjconflict-side-0/default/assets/privacy/en/0.md b/.jjconflict-side-0/default/assets/privacy/en/0.md
deleted file mode 100644
index 9c8e6b15..00000000
--- a/.jjconflict-side-0/default/assets/privacy/en/0.md
+++ /dev/null
@@ -1,8 +0,0 @@
-# Privacy Policy
-
-Welcome!
-This is a placeholder Privacy Policy file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/assets/privacy/en/0.txt b/.jjconflict-side-0/default/assets/privacy/en/0.txt
deleted file mode 100644
index 9c8e6b15..00000000
--- a/.jjconflict-side-0/default/assets/privacy/en/0.txt
+++ /dev/null
@@ -1,8 +0,0 @@
-# Privacy Policy
-
-Welcome!
-This is a placeholder Privacy Policy file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/assets/terms/en/0.md b/.jjconflict-side-0/default/assets/terms/en/0.md
deleted file mode 100644
index 033a5937..00000000
--- a/.jjconflict-side-0/default/assets/terms/en/0.md
+++ /dev/null
@@ -1,8 +0,0 @@
-# Terms of Service
-
-Welcome!
-This is a placeholder Terms of Service file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/assets/terms/en/0.txt b/.jjconflict-side-0/default/assets/terms/en/0.txt
deleted file mode 100644
index 033a5937..00000000
--- a/.jjconflict-side-0/default/assets/terms/en/0.txt
+++ /dev/null
@@ -1,8 +0,0 @@
-# Terms of Service
-
-Welcome!
-This is a placeholder Terms of Service file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/master_offline_private_key b/.jjconflict-side-0/default/master_offline_private_key
deleted file mode 100644
index 739df007..00000000
Binary files a/.jjconflict-side-0/default/master_offline_private_key and /dev/null differ
diff --git a/.jjconflict-side-0/dune-project b/.jjconflict-side-0/dune-project
deleted file mode 100644
index d4fc79ff..00000000
--- a/.jjconflict-side-0/dune-project
+++ /dev/null
@@ -1,46 +0,0 @@
-(lang dune 3.20)
-
-(name mte)
-
-(generate_opam_files true)
-
-; (source
-; (github username/reponame))
-
-(authors "Olivier Pierre ")
-
-(maintainers "Olivier Pierre ")
-
-(license AGPL-3.0-only)
-
-; (documentation https://url/to/documentation)
-
-(package
- (name mte)
- (synopsis "MTE - the MirageOS Taler Exchange")
- (description "A GNU Taler exchange implementation with the unikernel framework MirageOS")
- (tags
- ("GNU Taler" MirageOS unikernel OCaml crypto))
- (depends
- (ocaml (>= 5.3))
- base32
- caqti
- caqti-miou
- caqti-driver-pgx
- crunch
- vif
- jsont
- cohttp
- fmt
- bin
- angstrom
- mirage-crypto
- kdf
- digestif
- duration
- jsont
- cohttp
- ptime
- logs
- (ocamlformat :with-dev-setup)
- ))
diff --git a/.jjconflict-side-0/mte.opam b/.jjconflict-side-0/mte.opam
deleted file mode 100644
index 3d706521..00000000
--- a/.jjconflict-side-0/mte.opam
+++ /dev/null
@@ -1,49 +0,0 @@
-# This file is generated by dune, edit dune-project instead
-opam-version: "2.0"
-synopsis: "MTE - the MirageOS Taler Exchange"
-description:
- "A GNU Taler exchange implementation with the unikernel framework MirageOS"
-maintainer: ["Olivier Pierre "]
-authors: ["Olivier Pierre "]
-license: "AGPL-3.0-only"
-tags: ["GNU Taler" "MirageOS" "unikernel" "OCaml" "crypto"]
-depends: [
- "dune" {>= "3.20"}
- "ocaml" {>= "5.3"}
- "base32"
- "caqti"
- "caqti-miou"
- "caqti-driver-pgx"
- "crunch"
- "vif"
- "jsont"
- "cohttp"
- "fmt"
- "bin"
- "angstrom"
- "mirage-crypto"
- "kdf"
- "digestif"
- "duration"
- "jsont"
- "cohttp"
- "ptime"
- "logs"
- "ocamlformat" {with-dev-setup}
- "odoc" {with-doc}
-]
-build: [
- ["dune" "subst"] {dev}
- [
- "dune"
- "build"
- "-p"
- name
- "-j"
- jobs
- "@install"
- "@runtest" {with-test}
- "@doc" {with-doc}
- ]
-]
-x-maintenance-intent: ["(latest)"]
diff --git a/.jjconflict-side-0/src/amount.ml b/.jjconflict-side-0/src/amount.ml
deleted file mode 100644
index c5e06082..00000000
--- a/.jjconflict-side-0/src/amount.ml
+++ /dev/null
@@ -1,127 +0,0 @@
-(* TODO
- have a currency agnostic amount_lib.ml
- and specialize amount.ml to Config.currency??
-
- have safe amount arithmetic *)
-type sign =
- | Sign_plus
- | Sign_minus
-
-type t = {
- sign: sign option;
- currency: string;
- value: Int64.t;
- fraction: Int32.t;
-}
-
-let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
-
-(* TODO
- the constraint is on the number of digits,
- so this wrong if leading 0s
- this depends on currency..? *)
-let fraction_upper_bound = Int32.of_int 100_000_000
-
-let make ~sign ~currency ~value ~fraction =
- if value < Int64.zero then Error "value is negative"
- else if fraction < Int32.zero then Error "fraction is negative"
- else if value > value_upper_bound then Error "value is greater than 2^52-1"
- else if fraction >= fraction_upper_bound then
- Error "fraction has more than 8 decimal digits"
- else Ok { sign; currency; value; fraction }
-
-module Parse = struct
- open Angstrom
-
- let sign =
- char '+' *> return (Some Sign_plus)
- <|> char '-' *> return (Some Sign_minus)
- <|> return None
-
- let currency =
- take_while1 (function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false)
- >>= fun s ->
- match String.length s < 12 with
- | false -> fail "currency is more than 11 characters"
- | true -> return s
-
- let int64 =
- take_while1 (function '0' .. '9' -> true | _ -> false)
- >>| Int64.of_string_opt
- >>= function
- | None -> fail "value is not a valid int64"
- | Some n when n >= value_upper_bound -> fail "value is greater than 2^52-1"
- | Some n -> return n
-
- let int32 =
- take_while1 (function '0' .. '9' -> true | _ -> false)
- >>| Int32.of_string_opt
- >>= function
- | None -> fail "fraction is not a valid int32"
- | Some n when n >= fraction_upper_bound ->
- fail "fraction is greater than 10^8-1"
- | Some n -> return n
-
- let amount =
- lift4
- (fun sign currency value fraction ->
- make ~sign ~currency ~value ~fraction)
- sign currency
- (char ':' *> int64)
- (char '.' *> int32 <|> return 0_l)
- <* end_of_input
-
- let f s = parse_string ~consume:Consume.All amount s |> Result.join
-end
-
-let of_string = Parse.f
-
-let pp =
- let open Fmt in
- let pp_sign ppf = function
- | Sign_plus -> char ppf '+'
- | Sign_minus -> char ppf '-'
- in
- fun ppf { sign; currency; value; fraction } ->
- (* TODO
- depends on the currency's number of fraction digits
- assumes value and fraction are in bounds *)
- pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction
-
-let to_string = Fmt.str "%a" pp
-
-(* - *)
-
-let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
-
-(* byte length of currency string *)
-let currency_len = 12
-
-let pad_currency_string s =
- let len = String.length s in
- assert (len < currency_len);
- let b = Bytes.make 12 '\x00' in
- Bytes.blit_string s 0 b 0 len;
- Bytes.to_string b
-
-(* binary decoding unused? *)
-let make_exn value fraction currency =
- match make ~sign:None ~currency ~value ~fraction with
- | Error _ -> Fmt.failwith "Amount of binary data failure"
- | Ok v -> v
-
-let bin =
- let open Bin in
- record make_exn
- |+ field neint64 (fun t -> t.value)
- |+ field neint32 (fun t -> t.fraction)
- |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
- |> sealr
-
-let bin_nbo =
- let open Bin in
- record make_exn
- |+ field beint64 (fun t -> t.value)
- |+ field beint32 (fun t -> t.fraction)
- |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
- |> sealr
diff --git a/.jjconflict-side-0/src/amount.mli b/.jjconflict-side-0/src/amount.mli
deleted file mode 100644
index f055430c..00000000
--- a/.jjconflict-side-0/src/amount.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-type sign =
- | Sign_plus
- | Sign_minus
-
-type t = private {
- sign: sign option;
- currency: string;
- value: Int64.t;
- fraction: Int32.t;
-}
-
-val make :
- sign:sign option ->
- currency:string ->
- value:Int64.t ->
- fraction:Int32.t ->
- (t, string) result
-
-val pp : Format.formatter -> t -> unit
-val to_string : t -> string
-val of_string : string -> (t, string) result
-
-(* - *)
-val jsont : t Jsont.t
-val bin : t Bin.t
-val bin_nbo : t Bin.t
-(* [caqti] is in pg_type.ml *)
diff --git a/.jjconflict-side-0/src/api.ml b/.jjconflict-side-0/src/api.ml
deleted file mode 100644
index 8a132db1..00000000
--- a/.jjconflict-side-0/src/api.ml
+++ /dev/null
@@ -1,1384 +0,0 @@
-(* TODO
- ppx?
- normalized JSON-object
- for signature of ExchangeKeysResponse.exetensions field
- option: correct use opt_mem or Jsont.option
- properly combine jsont for "interface DenomGroupRsa extends DenomGroupCommon"
- better types:
- - payto_uri
- - uri
- use of monotonic time for some validity_start/_end fields *)
-
-let protocol_version = "31:0:0"
-
-open Crypto
-open Signatures
-module DenominationHash = Hash.DenominationHash
-
-let encode_exn jsont v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok
-let encode jsont v = Jsont_bytesrw.encode_string jsont v
-let decode jsont v = Jsont_bytesrw.decode_string jsont v
-
-open Jsont.Object
-
-module Account_operation = struct
- type t =
- | Withdraw
- | Deposit
- | Merge
- | Balance
- | Close
- | Aggregate
- | Transaction
- | Refund
-
- let to_string t =
- String.uppercase_ascii
- @@
- match t with
- | Withdraw -> "withdraw"
- | Deposit -> "deposit"
- | Merge -> "merge"
- | Balance -> "balance"
- | Close -> "close"
- | Aggregate -> "aggregate"
- | Transaction -> "transaction"
- | Refund -> "refund"
-
- let jsont =
- [ Withdraw; Deposit; Merge; Balance; Close; Aggregate; Transaction; Refund ]
- |> List.map (fun t -> (to_string t, t))
- |> Jsont.enum ~kind:"account operation type"
-end
-
-module B32 = struct
- include B32
-
- let jsont = Jsont.of_of_string ~kind:"B32" B32.decode ~enc:B32.encode
-
- let caqti =
- Caqti_type.custom
- ~encode:(fun v -> Ok (B32.encode v))
- ~decode:B32.decode Caqti_type.string
-end
-
-(* TODO error response
- - use GANA error codes
- https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)
-module ErrorDetail = struct
- type t = {
- code: int;
- hint: string option;
- detail: string option;
- parameter: string option;
- path: string option;
- offset: string option;
- index: string option;
- object_: string option;
- currency: string option;
- type_expected: string option;
- type_actual: string option;
- extra: Jsont.json option;
- }
-
- let make code hint detail parameter path offset index object_ currency
- type_expected type_actual extra =
- {
- code;
- hint;
- detail;
- parameter;
- path;
- offset;
- index;
- object_;
- currency;
- type_expected;
- type_actual;
- extra;
- }
-
- let jsont =
- let code v = v.code in
- let hint v = v.hint in
- let detail v = v.detail in
- let parameter v = v.parameter in
- let path v = v.path in
- let offset v = v.offset in
- let index v = v.index in
- let object_ v = v.object_ in
- let currency v = v.currency in
- let type_expected v = v.type_expected in
- let type_actual v = v.type_actual in
- let extra v = v.extra in
-
- let open Jsont.Object in
- map ~kind:"ErrorDetail" make
- |> mem "code" Jsont.int ~enc:code
- |> opt_mem "hint" Jsont.string ~enc:hint
- |> opt_mem "detail" Jsont.string ~enc:detail
- |> opt_mem "parameter" Jsont.string ~enc:parameter
- |> opt_mem "path" Jsont.string ~enc:path
- |> opt_mem "offset" Jsont.string ~enc:offset
- |> opt_mem "index" Jsont.string ~enc:index
- |> opt_mem "object" Jsont.string ~enc:object_
- |> opt_mem "currency" Jsont.string ~enc:currency
- |> opt_mem "type_expected" Jsont.string ~enc:type_expected
- |> opt_mem "type_actual" Jsont.string ~enc:type_actual
- |> opt_mem "extra" (Jsont.any ()) ~enc:extra
- |> finish
-
- let make ?hint ?detail ?parameter ?path ?offset ?index ?object_ ?currency
- ?type_expected ?type_actual ?extra code =
- make code hint detail parameter path offset index object_ currency
- type_expected type_actual extra
-end
-
-module CurrencySpecification = struct
- type t = {
- name: string;
- num_fractional_input_digits: int;
- num_fractional_normal_digits: int;
- num_fractional_trailing_zero_digits: int;
- alt_unit_names: string;
- common_amounts: Amount.t list;
- }
-
- let jsont =
- let make name num_fractional_input_digits num_fractional_normal_digits
- num_fractional_trailing_zero_digits alt_unit_names common_amounts =
- {
- name;
- num_fractional_input_digits;
- num_fractional_normal_digits;
- num_fractional_trailing_zero_digits;
- alt_unit_names;
- common_amounts;
- }
- in
- let name v = v.name in
- let num_fractional_input_digits v = v.num_fractional_input_digits in
- let num_fractional_normal_digits v = v.num_fractional_normal_digits in
- let num_fractional_trailing_zero_digits v =
- v.num_fractional_trailing_zero_digits
- in
- let alt_unit_names v = v.alt_unit_names in
- let common_amounts v = v.common_amounts in
- map ~kind:"CurrencySpecification" make
- |> mem "name" Jsont.string ~enc:name
- |> mem "num_fractional_input_digits" Jsont.int
- ~enc:num_fractional_input_digits
- |> mem "num_fractional_normal_digits" Jsont.int
- ~enc:num_fractional_normal_digits
- |> mem "num_fractional_trailing_zero_digits" Jsont.int
- ~enc:num_fractional_trailing_zero_digits
- |> mem "alt_unit_names" Jsont.string ~enc:alt_unit_names
- |> mem "common_amounts" (Jsont.list Amount.jsont) ~enc:common_amounts
- |> finish
-end
-
-module ExchangeVersionResponse = struct
- type t = {
- version: string;
- (* todo jsont const string
- `name: "taler-exchange"` *)
- name: string;
- implementation: string option;
- currency: string;
- shopping_url: string option;
- open_banking_gateway: string option;
- currency_specification: CurrencySpecification.t;
- aml_spa_dialect: string option;
- }
-
- let jsont =
- let make version name implementation currency shopping_url
- open_banking_gateway currency_specification aml_spa_dialect =
- {
- version;
- name;
- implementation;
- currency;
- shopping_url;
- open_banking_gateway;
- currency_specification;
- aml_spa_dialect;
- }
- in
- let version v = v.version in
- let name v = v.name in
- let implementation v = v.implementation in
- let currency v = v.currency in
- let shopping_url v = v.shopping_url in
- let open_banking_gateway v = v.open_banking_gateway in
- let currency_specification v = v.currency_specification in
- let aml_spa_dialect v = v.aml_spa_dialect in
- map ~kind:"ExchangeVersionResponse" make
- |> mem "version" Jsont.string ~enc:version
- |> mem "name" Jsont.string ~enc:name
- |> mem "implementation" (Jsont.option Jsont.string) ~enc:implementation
- |> mem "currency" Jsont.string ~enc:currency
- |> mem "shopping_url" (Jsont.option Jsont.string) ~enc:shopping_url
- |> mem "open_banking_gateway"
- (Jsont.option Jsont.string)
- ~enc:open_banking_gateway
- |> mem "currency_specification" CurrencySpecification.jsont
- ~enc:currency_specification
- |> mem "aml_spa_dialect" (Jsont.option Jsont.string) ~enc:aml_spa_dialect
- |> finish
-end
-
-let config =
- let currency_specification =
- let open Config.Currency 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
- ExchangeVersionResponse.
- {
- version= protocol_version;
- name= "taler-exchange";
- currency= Config.currency;
- currency_specification;
- implementation= None;
- shopping_url= None;
- open_banking_gateway= None;
- aml_spa_dialect= None;
- }
-
-module RsaDenominationKey = struct
- type t = {
- age_mask: int;
- rsa_pub: RsaPublicKey.t;
- }
-
- let jsont =
- let make age_mask rsa_pub = { age_mask; rsa_pub } in
- let age_mask v = v.age_mask in
- let rsa_pub v = v.rsa_pub in
- Jsont.Object.map ~kind:"RsaDenominationKey" make
- |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask
- |> Jsont.Object.mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
- |> Jsont.Object.finish
-end
-
-(* ! Clause Schnorr cipher is not supported *)
-module DenominationKey = struct
- type t = Rsa of RsaDenominationKey.t
-
- let to_octets = function Rsa denom -> RsaPublicKey.to_octets denom.rsa_pub
-
- let of_cs _v =
- Jsont.Error.msg Jsont.Meta.none "CSDenominationKey are not supported"
-
- let of_rsa v = Rsa v
-
- let jsont =
- let rsa = Case.map "RSA" RsaDenominationKey.jsont ~dec:of_rsa in
- let cs = Case.map "CS" zero ~dec:of_cs in
- let enc_case = function Rsa v -> Case.value rsa v in
- let cases = Case.[ make rsa; make cs ] in
- map ~kind:"DenominationKey" Fun.id
- |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
- |> finish
-end
-
-module FutureSignKey = struct
- type t = {
- key: EddsaPublicKey.t;
- stamp_start: Timestamp.t;
- stamp_expire: Timestamp.t;
- stamp_end: Timestamp.t;
- signkey_secmod_sig: SigningKeyAnnouncement.t;
- }
-
- let jsont =
- let make key stamp_start stamp_expire stamp_end signkey_secmod_sig =
- { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
- in
- let key v = v.key in
- let stamp_start v = v.stamp_start in
- let stamp_expire v = v.stamp_expire in
- let stamp_end v = v.stamp_end in
- let signkey_secmod_sig v = v.signkey_secmod_sig in
- map ~kind:"FutureSignKey" make
- |> mem "key" EddsaPublicKey.jsont ~enc:key
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
- |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
- |> mem "signkey_secmod_sig" SigningKeyAnnouncement.jsont
- ~enc:signkey_secmod_sig
- |> finish
-end
-
-module FutureDenom = struct
- type t = {
- section_name: string;
- value: Amount.t;
- stamp_start: Timestamp.t;
- stamp_expire_withdraw: Timestamp.t;
- stamp_expire_deposit: Timestamp.t;
- stamp_expire_legal: Timestamp.t;
- denom_pub: DenominationKey.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- denom_secmod_sig: DenominationKeyAnnouncement.t;
- }
-
- let jsont =
- let make 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 =
- {
- 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;
- }
- in
- let section_name t = t.section_name in
- let value t = t.value in
- let stamp_start t = t.stamp_start in
- let stamp_expire_withdraw t = t.stamp_expire_withdraw in
- let stamp_expire_deposit t = t.stamp_expire_deposit in
- let stamp_expire_legal t = t.stamp_expire_legal in
- let denom_pub t = t.denom_pub in
- let fee_withdraw t = t.fee_withdraw in
- let fee_deposit t = t.fee_deposit in
- let fee_refresh t = t.fee_refresh in
- let fee_refund t = t.fee_refund in
- let denom_secmod_sig t = t.denom_secmod_sig in
- map ~kind:"FutureDenom" make
- |> mem "section_name" Jsont.string ~enc:section_name
- |> mem "value" Amount.jsont ~enc:value
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
- |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
- |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
- |> mem "denom_pub" DenominationKey.jsont ~enc:denom_pub
- |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
- |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
- |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
- |> mem "fee_refund" Amount.jsont ~enc:fee_refund
- |> mem "denom_secmod_sig" DenominationKeyAnnouncement.jsont
- ~enc:denom_secmod_sig
- |> finish
-end
-
-module FutureKeysResponse = struct
- type t = {
- future_denoms: FutureDenom.t list;
- future_signkeys: FutureSignKey.t list;
- master_pub: EddsaPublicKey.t;
- denom_secmod_public_key: EddsaPublicKey.t;
- signkey_secmod_public_key: EddsaPublicKey.t;
- }
-
- let jsont =
- let make future_denoms future_signkeys master_pub denom_secmod_public_key
- signkey_secmod_public_key =
- {
- future_denoms;
- future_signkeys;
- master_pub;
- denom_secmod_public_key;
- signkey_secmod_public_key;
- }
- in
- let future_denoms t = t.future_denoms in
- let future_signkeys t = t.future_signkeys in
- let master_pub t = t.master_pub in
- let denom_secmod_public_key t = t.denom_secmod_public_key in
- let signkey_secmod_public_key t = t.signkey_secmod_public_key in
- map ~kind:"FutureKeysResponse" make
- |> mem "future_denoms" (Jsont.list FutureDenom.jsont) ~enc:future_denoms
- |> mem "future_signkeys"
- (Jsont.list FutureSignKey.jsont)
- ~enc:future_signkeys
- |> mem "master_pub" EddsaPublicKey.jsont ~enc:master_pub
- |> mem "denom_secmod_public_key" EddsaPublicKey.jsont
- ~enc:denom_secmod_public_key
- |> mem "signkey_secmod_public_key" EddsaPublicKey.jsont
- ~enc:signkey_secmod_public_key
- |> finish
-end
-
-module SignKeySignature = struct
- type t = {
- key: EddsaPublicKey.t;
- master_sig: ExchangeSigningKeyValidity.t;
- }
-
- let jsont =
- let make key master_sig = { key; master_sig } in
- let key v = v.key in
- let master_sig v = v.master_sig in
- map ~kind:"SignKeySignature" make
- |> mem "key" EddsaPublicKey.jsont ~enc:key
- |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
- |> finish
-end
-
-module DenomSignature = struct
- type t = {
- h_denom_pub: DenominationHash.t;
- master_sig: DenominationKeyValidity.t;
- }
-
- let jsont =
- let make h_denom_pub master_sig = { h_denom_pub; master_sig } in
- let h_denom_pub v = v.h_denom_pub in
- let master_sig v = v.master_sig in
- map ~kind:"DenomSignature" make
- |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub
- |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
- |> finish
-end
-
-module MasterSignatures = struct
- type t = {
- denom_sigs: DenomSignature.t list;
- signkey_sigs: SignKeySignature.t list;
- }
-
- let jsont =
- let make denom_sigs signkey_sigs = { denom_sigs; signkey_sigs } in
- let denom_sigs v = v.denom_sigs in
- let signkey_sigs v = v.signkey_sigs in
- map ~kind:"MasterSignatures" make
- |> mem "denom_sigs" (Jsont.list DenomSignature.jsont) ~enc:denom_sigs
- |> mem "signkey_sigs" (Jsont.list SignKeySignature.jsont) ~enc:signkey_sigs
- |> finish
-end
-
-module DenomRevocationSignature = struct
- type t = { master_sig: MasterDenominationKeyRevocation.t }
-
- let jsont =
- let make master_sig = { master_sig } in
- let enc v = v.master_sig in
- map ~kind:"DenomRevocationSignature" make
- |> mem "master_sig" MasterDenominationKeyRevocation.jsont ~enc
- |> finish
-end
-
-module SignkeyRevocationSignature = struct
- type t = { master_sig: MasterSigningKeyRevocation.t }
-
- let jsont =
- let make master_sig = { master_sig } in
- let enc v = v.master_sig in
- map ~kind:"SignkeyRevocationSignature" make
- |> mem "master_sig" MasterSigningKeyRevocation.jsont ~enc
- |> finish
-end
-
-module AuditorSetupMessage = struct
- type t = {
- auditor_url: string;
- auditor_name: string;
- auditor_pub: EddsaPublicKey.t;
- master_sig: MasterAddAuditor.t;
- validity_start: Timestamp.t;
- }
-
- let jsont =
- let make auditor_url auditor_name auditor_pub master_sig validity_start =
- { auditor_url; auditor_name; auditor_pub; master_sig; validity_start }
- in
- let auditor_url v = v.auditor_url in
- let auditor_name v = v.auditor_name in
- let auditor_pub v = v.auditor_pub in
- let master_sig v = v.master_sig in
- let validity_start v = v.validity_start in
- map ~kind:"AuditorSetupMessage" make
- |> mem "auditor_url" Jsont.string ~enc:auditor_url
- |> mem "auditor_name" Jsont.string ~enc:auditor_name
- |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub
- |> mem "master_sig" MasterAddAuditor.jsont ~enc:master_sig
- |> mem "validity_start" Timestamp.jsont ~enc:validity_start
- |> finish
-end
-
-module AuditorTeardownMessage = struct
- type t = {
- master_sig: MasterDelAuditor.t;
- validity_end: Timestamp.t;
- }
-
- let jsont =
- let make master_sig validity_end = { master_sig; validity_end } in
- let master_sig v = v.master_sig in
- let validity_end v = v.validity_end in
- map ~kind:"AuditorTeardownMessage" make
- |> mem "master_sig" MasterDelAuditor.jsont ~enc:master_sig
- |> mem "validity_end" Timestamp.jsont ~enc:validity_end
- |> finish
-end
-
-module WireFeeSetupMessage = struct
- type t = {
- wire_method: string;
- master_sig_wire: MasterWireFee.t;
- fee_start: Timestamp.t;
- fee_end: Timestamp.t;
- closing_fee: Amount.t;
- wire_fee: Amount.t;
- }
-
- let jsont =
- let make wire_method master_sig_wire fee_start fee_end closing_fee wire_fee
- =
- {
- wire_method;
- master_sig_wire;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- }
- in
- let wire_method v = v.wire_method in
- let master_sig_wire v = v.master_sig_wire in
- let fee_start v = v.fee_start in
- let fee_end v = v.fee_end in
- let closing_fee v = v.closing_fee in
- let wire_fee v = v.wire_fee in
- map ~kind:"WireFeeSetupMessage" make
- |> mem "wire_method" Jsont.string ~enc:wire_method
- |> mem "master_sig_wire" MasterWireFee.jsont ~enc:master_sig_wire
- |> mem "fee_start" Timestamp.jsont ~enc:fee_start
- |> mem "fee_end" Timestamp.jsont ~enc:fee_end
- |> mem "closing_fee" Amount.jsont ~enc:closing_fee
- |> mem "wire_fee" Amount.jsont ~enc:wire_fee
- |> finish
-end
-
-module GlobalFees = struct
- type t = {
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- history_fee: Amount.t;
- account_fee: Amount.t;
- purse_fee: Amount.t;
- history_expiration: Time.Relative.t;
- purse_account_limit: int32;
- purse_timeout: Time.Relative.t;
- master_sig: GlobalFees.t;
- }
-
- let jsont =
- let make start_date end_date history_fee account_fee purse_fee
- history_expiration purse_account_limit purse_timeout master_sig =
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- }
- in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let history_fee v = v.history_fee in
- let account_fee v = v.account_fee in
- let purse_fee v = v.purse_fee in
- let history_expiration v = v.history_expiration in
- let purse_account_limit v = v.purse_account_limit in
- let purse_timeout v = v.purse_timeout in
- let master_sig v = v.master_sig in
- map ~kind:"GlobalFees" make
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "history_fee" Amount.jsont ~enc:history_fee
- |> mem "account_fee" Amount.jsont ~enc:account_fee
- |> mem "purse_fee" Amount.jsont ~enc:purse_fee
- |> mem "history_expiration" Time.Relative.jsont ~enc:history_expiration
- |> mem "purse_account_limit" Jsont.int32 ~enc:purse_account_limit
- |> mem "purse_timeout" Time.Relative.jsont ~enc:purse_timeout
- |> mem "master_sig" GlobalFees.jsont ~enc:master_sig
- |> finish
-end
-
-module WireSetupMessage = struct
- type t = {
- payto_uri: string;
- master_sig_wire: MasterWireDetails.t;
- master_sig_add: MasterAddWire.t;
- validity_start: Timestamp.t;
- bank_label: string option;
- priority: int option;
- }
-
- let jsont =
- let make payto_uri master_sig_wire master_sig_add validity_start bank_label
- priority =
- {
- payto_uri;
- master_sig_wire;
- master_sig_add;
- validity_start;
- bank_label;
- priority;
- }
- in
- let payto_uri v = v.payto_uri in
- let master_sig_wire v = v.master_sig_wire in
- let master_sig_add v = v.master_sig_add in
- let validity_start v = v.validity_start in
- let bank_label v = v.bank_label in
- let priority v = v.priority in
- map ~kind:"WireSetupMessage" make
- |> mem "payto_uri" Jsont.string ~enc:payto_uri
- |> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire
- |> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add
- |> mem "validity_start" Timestamp.jsont ~enc:validity_start
- |> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label
- |> mem "priority" (Jsont.option Jsont.int) ~enc:priority
- |> finish
-end
-
-module WireTeardownMessage = struct
- type t = {
- payto_uri: string;
- master_sig_del: MasterDelWire.t;
- validity_end: Timestamp.t;
- }
-
- let jsont =
- let make payto_uri master_sig_del validity_end =
- { payto_uri; master_sig_del; validity_end }
- in
- let payto_uri v = v.payto_uri in
- let master_sig_del v = v.master_sig_del in
- let validity_end v = v.validity_end in
- map ~kind:"WireTeardownMessage" make
- |> mem "payto_uri" Jsont.string ~enc:payto_uri
- |> mem "master_sig_del" MasterDelWire.jsont ~enc:master_sig_del
- |> mem "validity_end" Timestamp.jsont ~enc:validity_end
- |> finish
-end
-
-module DrainProfitsMessage = struct
- type t = {
- wtid: B32.t;
- debit_account_section: string;
- credit_payto_uri: string;
- date: Timestamp.t;
- amount: Amount.t;
- master_sig: MasterDrainProfit.t;
- }
-
- let jsont =
- let make debit_account_section credit_payto_uri wtid master_sig date amount
- =
- {
- debit_account_section;
- credit_payto_uri;
- wtid;
- master_sig;
- date;
- amount;
- }
- in
- let debit_account_section v = v.debit_account_section in
- let credit_payto_uri v = v.credit_payto_uri in
- let wtid v = v.wtid in
- let master_sig v = v.master_sig in
- let date v = v.date in
- let amount v = v.amount in
- map ~kind:"DrainProfitsMessage" make
- |> mem "debit_account_section" Jsont.string ~enc:debit_account_section
- |> mem "credit_payto_uri" Jsont.string ~enc:credit_payto_uri
- |> mem "wtid" B32.jsont ~enc:wtid
- |> mem "master_sig" MasterDrainProfit.jsont ~enc:master_sig
- |> mem "date" Timestamp.jsont ~enc:date
- |> mem "amount" Amount.jsont ~enc:amount
- |> finish
-end
-
-module AmlOfficerSetup = struct
- type t = {
- officer_pub: EddsaPublicKey.t;
- master_sig: MasterAmlOfficerStatus.t;
- officer_name: string;
- is_active: bool;
- read_only: bool;
- change_date: Timestamp.t;
- }
-
- let jsont =
- let make officer_pub officer_name is_active read_only master_sig change_date
- =
- {
- officer_pub;
- officer_name;
- is_active;
- read_only;
- master_sig;
- change_date;
- }
- in
- let officer_pub v = v.officer_pub in
- let officer_name v = v.officer_name in
- let is_active v = v.is_active in
- let read_only v = v.read_only in
- let master_sig v = v.master_sig in
- let change_date v = v.change_date in
- map ~kind:"AmlOfficerSetup" make
- |> mem "officer_pub" EddsaPublicKey.jsont ~enc:officer_pub
- |> mem "officer_name" Jsont.string ~enc:officer_name
- |> mem "is_active" Jsont.bool ~enc:is_active
- |> mem "read_only" Jsont.bool ~enc:read_only
- |> mem "master_sig" MasterAmlOfficerStatus.jsont ~enc:master_sig
- |> mem "change_date" Timestamp.jsont ~enc:change_date
- |> finish
-end
-
-module ExchangePartnerSetupRequest = struct
- type t = {
- partner_base_url: string;
- partner_pub: EddsaPublicKey.t;
- wad_frequency: Time.Relative.t;
- master_sig: PartnerConfiguration.t;
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- wad_fee: Amount.t;
- }
-
- let jsont =
- let make partner_base_url partner_pub wad_frequency master_sig start_date
- end_date wad_fee =
- {
- partner_base_url;
- partner_pub;
- wad_frequency;
- master_sig;
- start_date;
- end_date;
- wad_fee;
- }
- in
- let partner_base_url v = v.partner_base_url in
- let partner_pub v = v.partner_pub in
- let wad_frequency v = v.wad_frequency in
- let master_sig v = v.master_sig in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let wad_fee v = v.wad_fee in
- map ~kind:"ExchangePartnerSetupRequest" make
- |> mem "partner_base_url" Jsont.string ~enc:partner_base_url
- |> mem "partner_pub" EddsaPublicKey.jsont ~enc:partner_pub
- |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency
- |> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "wad_fee" Amount.jsont ~enc:wad_fee
- |> finish
-end
-
-(* -- types for /keys -- *)
-
-module ExchangePartnerListEntry = struct
- type t = {
- partner_base_url: string;
- partner_master_pub: EddsaPublicKey.t;
- wad_fee: Amount.t;
- wad_frequency: Time.Relative.t;
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- master_sig: WadPartnerSignature.t;
- }
-
- let jsont =
- let make partner_base_url partner_master_pub wad_fee wad_frequency
- start_date end_date master_sig =
- {
- partner_base_url;
- partner_master_pub;
- wad_fee;
- wad_frequency;
- start_date;
- end_date;
- master_sig;
- }
- in
- let partner_base_url v = v.partner_base_url in
- let partner_master_pub v = v.partner_master_pub in
- let wad_fee v = v.wad_fee in
- let wad_frequency v = v.wad_frequency in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let master_sig v = v.master_sig in
- map ~kind:"ExchangePartnerListEntry" make
- |> mem "partner_base_url" Jsont.string ~enc:partner_base_url
- |> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub
- |> mem "wad_fee" Amount.jsont ~enc:wad_fee
- |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "master_sig" WadPartnerSignature.jsont ~enc:master_sig
- |> finish
-end
-
-module AggregateTransferFee = struct
- type t = {
- wire_fee: Amount.t;
- closing_fee: Amount.t;
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- sig_: MasterWireFee.t;
- }
-
- let jsont =
- let make wire_fee closing_fee start_date end_date sig_ =
- { wire_fee; closing_fee; start_date; end_date; sig_ }
- in
- let wire_fee v = v.wire_fee in
- let closing_fee v = v.closing_fee in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let sig_ v = v.sig_ in
- map ~kind:"AggregateTransferFee" make
- |> mem "wire_fee" Amount.jsont ~enc:wire_fee
- |> mem "closing_fee" Amount.jsont ~enc:closing_fee
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "sig" MasterWireFee.jsont ~enc:sig_
- |> finish
-end
-
-module AuditorDenominationKey = struct
- type t = {
- denom_pub_h: DenominationHash.t;
- auditor_sig: ExchangeKeyValidity.t;
- }
-
- let jsont =
- let make denom_pub_h auditor_sig = { denom_pub_h; auditor_sig } in
- let denom_pub_h v = v.denom_pub_h in
- let auditor_sig v = v.auditor_sig in
- map ~kind:"AuditorDenominationKey" make
- |> mem "denom_pub_h" DenominationHash.jsont ~enc:denom_pub_h
- |> mem "auditor_sig" ExchangeKeyValidity.jsont ~enc:auditor_sig
- |> finish
-end
-
-module AuditorKeys = struct
- type t = {
- auditor_pub: EddsaPublicKey.t;
- auditor_url: string;
- auditor_name: string;
- denomination_keys: AuditorDenominationKey.t list;
- }
-
- let jsont =
- let make auditor_pub auditor_url auditor_name denomination_keys =
- { auditor_pub; auditor_url; auditor_name; denomination_keys }
- in
- let auditor_pub v = v.auditor_pub in
- let auditor_url v = v.auditor_url in
- let auditor_name v = v.auditor_name in
- let denomination_keys v = v.denomination_keys in
- map ~kind:"AuditorKeys" make
- |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub
- |> mem "auditor_url" Jsont.string ~enc:auditor_url
- |> mem "auditor_name" Jsont.string ~enc:auditor_name
- |> mem "denomination_keys"
- (Jsont.list AuditorDenominationKey.jsont)
- ~enc:denomination_keys
- |> finish
-end
-
-module SignKey = struct
- type t = {
- key: EddsaPublicKey.t;
- stamp_start: Timestamp.t;
- stamp_expire: Timestamp.t;
- stamp_end: Timestamp.t;
- master_sig: ExchangeSigningKeyValidity.t;
- }
-
- (* TODO rm one of them *)
- let of_signkey
- Signkey.
- {
- pub;
- stamp_start;
- stamp_expire;
- stamp_end;
- master_sig;
- revoked_sig= _;
- } =
- { key= pub; stamp_start; stamp_expire; stamp_end; master_sig }
-
- let jsont =
- let make key stamp_start stamp_expire stamp_end master_sig =
- { key; stamp_start; stamp_expire; stamp_end; master_sig }
- in
- let key v = v.key in
- let stamp_start v = v.stamp_start in
- let stamp_expire v = v.stamp_expire in
- let stamp_end v = v.stamp_end in
- let master_sig v = v.master_sig in
- map ~kind:"SignKey" make
- |> mem "key" EddsaPublicKey.jsont ~enc:key
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
- |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
- |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
- |> finish
-end
-
-module RecoupDenoms = struct
- type t = { h_denom_pub: DenominationHash.t }
-
- let jsont =
- let make h_denom_pub = { h_denom_pub } in
- let h_denom_pub v = v.h_denom_pub in
- map ~kind:"RecoupDenoms" make
- |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub
- |> finish
-end
-
-module RsaDenom = struct
- (* correspond to: ({ rsa_pub: RsaPublicKey;} & DenomCommon) *)
- type t = {
- rsa_pub: RsaPublicKey.t;
- master_sig: DenominationKeyValidity.t;
- stamp_start: Timestamp.t;
- stamp_expire_withdraw: Timestamp.t;
- stamp_expire_deposit: Timestamp.t;
- stamp_expire_legal: Timestamp.t;
- lost: bool option;
- }
-
- let jsont =
- let make rsa_pub master_sig stamp_start stamp_expire_withdraw
- stamp_expire_deposit stamp_expire_legal lost =
- {
- rsa_pub;
- master_sig;
- stamp_start;
- stamp_expire_withdraw;
- stamp_expire_deposit;
- stamp_expire_legal;
- lost;
- }
- in
- let rsa_pub v = v.rsa_pub in
- let master_sig v = v.master_sig in
- let stamp_start v = v.stamp_start in
- let stamp_expire_withdraw v = v.stamp_expire_withdraw in
- let stamp_expire_deposit v = v.stamp_expire_deposit in
- let stamp_expire_legal v = v.stamp_expire_legal in
- let lost v = v.lost in
- map ~kind:"RsaDenom" make
- |> mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
- |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
- |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
- |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
- |> mem "lost" (Jsont.option Jsont.bool) ~enc:lost
- |> finish
-end
-
-module RsaDenomGroup = struct
- type t = {
- denoms: RsaDenom.t list;
- value: Amount.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- }
-
- let jsont =
- let make denoms value fee_withdraw fee_deposit fee_refresh fee_refund =
- { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
- in
- let denoms v = v.denoms in
- let value v = v.value in
- let fee_withdraw v = v.fee_withdraw in
- let fee_deposit v = v.fee_deposit in
- let fee_refresh v = v.fee_refresh in
- let fee_refund v = v.fee_refund in
- map ~kind:"RsaDenomGroup" make
- |> mem "denoms" (Jsont.list RsaDenom.jsont) ~enc:denoms
- |> mem "value" Amount.jsont ~enc:value
- |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
- |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
- |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
- |> mem "fee_refund" Amount.jsont ~enc:fee_refund
- |> finish
-end
-
-module DenomGroup = struct
- type t = Rsa of RsaDenomGroup.t
-
- let of_rsa v = Rsa v
-
- let of_cs _v =
- Jsont.Error.msg Jsont.Meta.none "CSDenomGroup are not supported"
-
- let of_rsa_age_restricted _v =
- Jsont.Error.msg Jsont.Meta.none
- "DenomGroupRsaAgeRestricted are not supported"
-
- let jsont =
- let rsa = Case.map "RSA" RsaDenomGroup.jsont ~dec:of_rsa in
- let cs = Case.map "CS" zero ~dec:of_cs in
- let rsa_age_restricted =
- Case.map "RSA+age_restricted" zero ~dec:of_rsa_age_restricted
- in
- let cs_age_restricted = Case.map "CS+age_restricted" zero ~dec:of_cs in
- let enc_case = function Rsa v -> Case.value rsa v in
- let cases =
- Case.
- [ make rsa; make cs; make rsa_age_restricted; make cs_age_restricted ]
- in
- map ~kind:"DenomGroup" Fun.id
- |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
- |> finish
-end
-
-module AccountLimit = struct
- type t = {
- operation_type: Account_operation.t;
- timeframe: Time.Relative.t;
- threshold: Amount.t;
- soft_limit: bool option;
- }
-
- let jsont =
- let make operation_type timeframe threshold soft_limit =
- { operation_type; timeframe; threshold; soft_limit }
- in
- let operation_type v = v.operation_type in
- let timeframe v = v.timeframe in
- let threshold v = v.threshold in
- let soft_limit v = v.soft_limit in
- map ~kind:"AccountLimit" make
- |> mem "operation_type" Account_operation.jsont ~enc:operation_type
- |> mem "timeframe" Time.Relative.jsont ~enc:timeframe
- |> mem "threshold" Amount.jsont ~enc:threshold
- |> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit
- |> finish
-end
-
-module ZeroLimitedOperation = struct
- type t = { operation_type: Account_operation.t }
-
- let jsont =
- let make operation_type = { operation_type } in
- let operation_type v = v.operation_type in
- map ~kind:"ZeroLimitedOperation" make
- |> mem "operation_type" Account_operation.jsont ~enc:operation_type
- |> finish
-end
-
-module RegexAccountRestriction = struct
- type t = {
- payto_regex: string;
- human_hint: string;
- (* Map from IETF BCP 47 language tags to localized human hints. *)
- human_hint_i18n: string option;
- }
-
- let jsont =
- let make payto_regex human_hint human_hint_i18n =
- { payto_regex; human_hint; human_hint_i18n }
- in
- let payto_regex v = v.payto_regex in
- let human_hint v = v.human_hint in
- let human_hint_i18n v = v.human_hint_i18n in
- map ~kind:"RegexAccountRestriction" make
- |> mem "payto_regex" Jsont.string ~enc:payto_regex
- |> mem "human_hint" Jsont.string ~enc:human_hint
- |> opt_mem "human_hint_i18n" Jsont.string ~enc:human_hint_i18n
- |> finish
-end
-
-module AccountRestriction = struct
- type t =
- | Deny
- | Regex of RegexAccountRestriction.t
-
- let of_regex v = Regex v
- let of_deny () = Deny
-
- let jsont =
- let regex = Case.map "regex" RegexAccountRestriction.jsont ~dec:of_regex in
- let deny = Case.map "deny" zero ~dec:of_deny in
- let enc_case = function
- | Regex v -> Case.value regex v
- | Deny -> Case.value deny ()
- in
- let cases = Case.[ make regex; make deny ] in
- map ~kind:"AccountRestriction" Fun.id
- |> case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
- |> finish
-end
-
-module ExchangeWireAccount = struct
- type t = {
- payto_uri: string;
- conversion_url: string option;
- credit_restrictions: AccountRestriction.t list;
- debit_restrictions: AccountRestriction.t list;
- master_sig: MasterWireDetails.t;
- bank_label: string option;
- priority: int option;
- }
-
- let jsont =
- let make payto_uri conversion_url credit_restrictions debit_restrictions
- master_sig bank_label priority =
- {
- payto_uri;
- conversion_url;
- credit_restrictions;
- debit_restrictions;
- master_sig;
- bank_label;
- priority;
- }
- in
- let payto_uri v = v.payto_uri in
- let conversion_url v = v.conversion_url in
- let credit_restrictions v = v.credit_restrictions in
- let debit_restrictions v = v.debit_restrictions in
- let master_sig v = v.master_sig in
- let bank_label v = v.bank_label in
- let priority v = v.priority in
- map ~kind:"ExchangeWireAccount" make
- |> mem "payto_uri" Jsont.string ~enc:payto_uri
- |> opt_mem "conversion_url" Jsont.string ~enc:conversion_url
- |> mem "credit_restrictions"
- (Jsont.list AccountRestriction.jsont)
- ~enc:credit_restrictions
- |> mem "debit_restrictions"
- (Jsont.list AccountRestriction.jsont)
- ~enc:debit_restrictions
- |> mem "master_sig" MasterWireDetails.jsont ~enc:master_sig
- |> opt_mem "bank_label" Jsont.string ~enc:bank_label
- |> opt_mem "priority" Jsont.int ~enc:priority
- |> finish
-end
-
-module ExtensionManifest = struct
- type t = {
- critical: bool;
- version: string;
- config: Jsont.json option;
- }
-
- let jsont =
- let make critical version config = { critical; version; config } in
- let critical v = v.critical in
- let version v = v.version in
- let config v = v.config in
- map ~kind:"ExtensionManifest" make
- |> mem "critical" Jsont.bool ~enc:critical
- |> mem "version" Jsont.string ~enc:version
- |> opt_mem "config" (Jsont.any ()) ~enc:config
- |> finish
-end
-
-module ExchangeKeysResponse = struct
- module String_map = Map.Make (String)
-
- type t = {
- version: string;
- base_url: string;
- currency: string;
- shopping_url: string option;
- open_banking_gateway: string option;
- bank_compliance_language: string option;
- currency_specification: CurrencySpecification.t;
- tiny_amount: Amount.t option;
- stefan_abs: Amount.t;
- stefan_log: Amount.t;
- stefan_lin: Float.t;
- asset_type: string;
- accounts: ExchangeWireAccount.t list;
- wire_fees: AggregateTransferFee.t list Stdlib.Map.Make(Stdlib.String).t;
- wads: ExchangePartnerListEntry.t list;
- rewards_allowed: bool;
- kyc_enabled: bool;
- disable_direct_deposit: bool;
- master_public_key: EddsaPublicKey.t;
- reserve_closing_delay: Time.Relative.t;
- wallet_balance_limit_without_kyc: Amount.t list option;
- hard_limits: AccountLimit.t list;
- zero_limits: ZeroLimitedOperation.t list;
- denominations: DenomGroup.t list;
- (* 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" *)
- exchange_sig: ExchangeKeySet.t;
- exchange_pub: EddsaPublicKey.t;
- recoup: RecoupDenoms.t list;
- global_fees: GlobalFees.t list;
- list_issue_date: Timestamp.t;
- auditors: AuditorKeys.t list;
- signkeys: SignKey.t list;
- extensions: ExtensionManifest.t Stdlib.Map.Make(Stdlib.String).t option;
- (* Signature by the exchange master key of the SHA-256 hash of the
- normalized JSON-object of field extensions, if it was set.
- The signature has purpose TALER_SIGNATURE_MASTER_EXTENSIONS. *)
- extensions_sig: EddsaSignature.t option;
- }
-
- let jsont =
- let make 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 =
- {
- 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;
- }
- in
-
- let version v = v.version in
- let base_url v = v.base_url in
- let currency v = v.currency in
- let shopping_url v = v.shopping_url in
- let open_banking_gateway v = v.open_banking_gateway in
- let bank_compliance_language v = v.bank_compliance_language in
- let currency_specification v = v.currency_specification in
- let tiny_amount v = v.tiny_amount in
- let stefan_abs v = v.stefan_abs in
- let stefan_log v = v.stefan_log in
- let stefan_lin v = v.stefan_lin in
- let asset_type v = v.asset_type in
- let accounts v = v.accounts in
- let wire_fees v = v.wire_fees in
- let wads v = v.wads in
- let rewards_allowed v = v.rewards_allowed in
- let kyc_enabled v = v.kyc_enabled in
- let disable_direct_deposit v = v.disable_direct_deposit in
- let master_public_key v = v.master_public_key in
- let reserve_closing_delay v = v.reserve_closing_delay in
- let wallet_balance_limit_without_kyc v =
- v.wallet_balance_limit_without_kyc
- in
- let hard_limits v = v.hard_limits in
- let zero_limits v = v.zero_limits in
- let denominations v = v.denominations in
- let exchange_sig v = v.exchange_sig in
- let exchange_pub v = v.exchange_pub in
- let recoup v = v.recoup in
- let global_fees v = v.global_fees in
- let list_issue_date v = v.list_issue_date in
- let auditors v = v.auditors in
- let signkeys v = v.signkeys in
- let extensions v = v.extensions in
- let extensions_sig v = v.extensions_sig in
- map ~kind:"ExchangeKeysResponse" make
- |> mem "version" Jsont.string ~enc:version
- |> mem "base_url" Jsont.string ~enc:base_url
- |> mem "currency" Jsont.string ~enc:currency
- |> opt_mem "shopping_url" Jsont.string ~enc:shopping_url
- |> opt_mem "open_banking_gateway" Jsont.string ~enc:open_banking_gateway
- |> opt_mem "bank_compliance_language" Jsont.string
- ~enc:bank_compliance_language
- |> mem "currency_specification" CurrencySpecification.jsont
- ~enc:currency_specification
- |> opt_mem "tiny_amount" Amount.jsont ~enc:tiny_amount
- |> mem "stefan_abs" Amount.jsont ~enc:stefan_abs
- |> mem "stefan_log" Amount.jsont ~enc:stefan_log
- |> mem "stefan_lin" Jsont.number ~enc:stefan_lin
- |> mem "asset_type" Jsont.string ~enc:asset_type
- |> mem "accounts" (Jsont.list ExchangeWireAccount.jsont) ~enc:accounts
- |> mem "wire_fees"
- (Jsont.Object.as_string_map (Jsont.list AggregateTransferFee.jsont))
- ~enc:wire_fees
- |> mem "wads" (Jsont.list ExchangePartnerListEntry.jsont) ~enc:wads
- |> mem "rewards_allowed" Jsont.bool ~enc:rewards_allowed
- |> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled
- |> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit
- |> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key
- |> mem "reserve_closing_delay" Time.Relative.jsont
- ~enc:reserve_closing_delay
- |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont)
- ~enc:wallet_balance_limit_without_kyc
- |> mem "hard_limits" (Jsont.list AccountLimit.jsont) ~enc:hard_limits
- |> mem "zero_limits"
- (Jsont.list ZeroLimitedOperation.jsont)
- ~enc:zero_limits
- |> mem "denominations" (Jsont.list DenomGroup.jsont) ~enc:denominations
- |> mem "exchange_sig" ExchangeKeySet.jsont ~enc:exchange_sig
- |> mem "exchange_pub" EddsaPublicKey.jsont ~enc:exchange_pub
- |> mem "recoup" (Jsont.list RecoupDenoms.jsont) ~enc:recoup
- |> mem "global_fees" (Jsont.list GlobalFees.jsont) ~enc:global_fees
- |> mem "list_issue_date" Timestamp.jsont ~enc:list_issue_date
- |> mem "auditors" (Jsont.list AuditorKeys.jsont) ~enc:auditors
- |> mem "signkeys" (Jsont.list SignKey.jsont) ~enc:signkeys
- |> opt_mem "extensions"
- (Jsont.Object.as_string_map ExtensionManifest.jsont)
- ~enc:extensions
- |> opt_mem "extensions_sig" EddsaSignature.jsont ~enc:extensions_sig
- |> finish
-end
diff --git a/.jjconflict-side-0/src/assets.ml b/.jjconflict-side-0/src/assets.ml
deleted file mode 100644
index 9313ee49..00000000
--- a/.jjconflict-side-0/src/assets.ml
+++ /dev/null
@@ -1,163 +0,0 @@
-(* https://docs.taler.net/design-documents/003-tos-rendering.html
-
- must support `text/plain` and `text/markdown` *)
-
-type t =
- | Terms
- | Privacy
-
-module Assets_config = struct
- (* hardcoded config just for static assets *)
- let default_lang = "en"
- let default_mimetype = ("text", "plain")
- let default_extension = ".txt"
- let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
- let base_dir = function Terms -> "terms" | Privacy -> "privacy"
-
- (* TODO this should be in the config like terms_etag *)
- let terms_legal_version = "0"
-end
-
-let etag k =
- match k with Terms -> Config.terms_etag | Privacy -> Config.privacy_etag
-
-let supported_lang_arr, supported_ext_arr =
- let aux t =
- let prefix = Fpath.v (Assets_config.base_dir t) in
- let path_l = List.map Fpath.v Assets_crunch.file_list in
- let path_l = List.filter_map (Fpath.rem_prefix prefix) path_l in
- let ext_l =
- path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
- in
- let lang_l =
- List.map
- (fun path ->
- match Fpath.segs path with
- | [] -> assert false
- | [ dir; _file ] -> dir
- | _l ->
- Fmt.failwith "invalid folder structure, file `%s` is misplaced"
- (Fpath.to_string Fpath.(prefix // path)))
- path_l
- in
- let lang_l = List.sort_uniq String.compare lang_l in
- let etag = (etag t).value in
- List.iter
- (fun path ->
- let etag' = Fpath.to_string (Fpath.rem_ext (Fpath.base path)) in
- if not @@ String.equal etag etag' then
- Fmt.failwith
- "filename of file `%s` does not match configuration ETAG value `%s`"
- (Fpath.to_string Fpath.(prefix // path))
- etag)
- path_l;
- if List.is_empty lang_l then Fmt.failwith "no language supported";
- if List.is_empty ext_l then Fmt.failwith "no mimetype supported";
- if not @@ List.mem Assets_config.default_lang lang_l then
- Fmt.failwith "default language `%s` files not found"
- Assets_config.default_lang;
- if not @@ List.mem ".txt" ext_l then
- Fmt.failwith "plain text file not found";
- if not @@ List.mem ".md" ext_l then Fmt.failwith "markdown file not found";
- List.iter
- (fun dir ->
- if String.length dir <> 2 then
- Fmt.failwith "language directory with invalid name: `%s`" dir)
- lang_l;
- if List.length path_l <> List.length ext_l * List.length lang_l then
- Fmt.failwith
- "invalid folder structure, all supported language must provide the \
- same set of file mimetype"
- else (lang_l, ext_l)
- in
- let lang_l, ext_l = aux Terms in
- let lang_l', ext_l' = aux Privacy in
- match
- List.equal String.equal lang_l lang_l'
- && List.equal String.equal ext_l ext_l'
- with
- | false ->
- Fmt.failwith
- "invalid folder structure, /terms and /privacy must support the same \
- set of languages and mimetypes"
- | true -> (Array.of_list lang_l, Array.of_list ext_l)
-
-module Mimetype = struct
- type t = string * string
-
- let pp fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
-
- let assoc =
- List.filter
- (fun (_mime, ext) -> Array.mem ext supported_ext_arr)
- [
- (("text", "plain"), ".txt");
- (("text", "markdown"), ".md");
- (("text", "html"), ".html");
- (("text", "html"), ".htm");
- (("application", "pdf"), ".pdf");
- (("image", "jpeg"), ".jpg");
- (("image", "jpeg"), ".jpeg");
- (("image", "png"), ".png");
- (("image", "gif"), ".gif");
- ]
-
- let arr =
- let all_supported, all_supported_ext = List.split assoc in
- match
- Array.find_opt
- (fun ext -> not @@ List.exists (( = ) ext) all_supported_ext)
- supported_ext_arr
- with
- | Some ext -> Fmt.failwith "extension `%s` unsupported" ext
- | None -> Array.of_list all_supported
-
- let default =
- match
- List.mem
- (Assets_config.default_mimetype, Assets_config.default_extension)
- assoc
- with
- | false ->
- Fmt.failwith "default content type `%a` not supported" pp
- Assets_config.default_mimetype
- | true -> Assets_config.default_mimetype
-
- let of_cohttp = function
- | Cohttp.Accept.MediaType (m, m_sub) ->
- Array.find_opt (( = ) (m, m_sub)) arr
- | AnyMediaSubtype m -> Array.find_opt (fun (m', _) -> String.equal m m') arr
- | AnyMedia -> Some default
-
- let to_extension_exn t =
- match List.assoc_opt t assoc with
- | None -> Fmt.failwith "Mimetype.to_extension failure: `%a` unknown" pp t
- | Some ext -> ext
-end
-
-module Language = struct
- type t = string
-
- let arr = supported_lang_arr
- let default = Assets_config.default_lang
-
- let of_cohttp = function
- | Cohttp.Accept.AnyLanguage -> Some default
- | Language language_range -> (
- (* ignore language subtags (e.g. "en-US" -> "en") *)
- match language_range with
- | [] -> assert false
- | lang :: _ when Array.mem lang supported_lang_arr -> Some lang
- | _ -> None)
-end
-
-(* ! lang and mime must be supported *)
-let get_content ~lang ~mime t =
- let ext = Mimetype.to_extension_exn mime in
- let path =
- Fpath.to_string
- Fpath.((v (Assets_config.base_dir t) / lang / (etag t).value) + ext)
- in
- match Assets_crunch.read path with
- | None -> Fmt.failwith "static file not found: `%s`" path
- | Some data -> data
diff --git a/.jjconflict-side-0/src/b32.ml b/.jjconflict-side-0/src/b32.ml
deleted file mode 100644
index 6bd06400..00000000
--- a/.jjconflict-side-0/src/b32.ml
+++ /dev/null
@@ -1,38 +0,0 @@
-(* Crockford's variant of Base32
- http://www.crockford.com/wrmg/base32.html
- except that:
- - 'U' is not excluded but also decodes to 'V'
- - '-' is not allowed
- - checksum is not allowed *)
-
-(* 'I' 'L' 'O' 'U' excluded
- no '=' padding in encoded string *)
-type t = string
-
-let alphabet = Base32.make_alphabet "0123456789ABCDEFGHJKMNPQRSTVWXYZ"
-
-let encode s =
- let s = Base32.encode_string ~alphabet s in
- (* remove '=' padding *)
- match String.index_opt s '=' with
- | None -> s
- | Some i -> String.sub s 0 i
-
-let decode s =
- let s =
- String.map
- (fun c ->
- match Char.uppercase_ascii c with
- | 'O' -> '0'
- | 'I' | 'L' -> '1'
- | 'U' -> 'V'
- | c -> c)
- s
- in
- (* restore padding for base32 lib *)
- let n = 8 - (String.length s mod 8) in
- let pad = String.make n '=' in
- let s = s ^ pad in
- match Base32.decode ~alphabet ~off:0 ~len:(String.length s) s with
- | Error (`Msg e) -> Error e
- | Ok v -> Ok v
diff --git a/.jjconflict-side-0/src/config.ml b/.jjconflict-side-0/src/config.ml
deleted file mode 100644
index 21666cf7..00000000
--- a/.jjconflict-side-0/src/config.ml
+++ /dev/null
@@ -1,203 +0,0 @@
-open Parse_config
-
-let config_filename = "mte.conf"
-let secrets_dir = Fpath.v "secrets"
-let secmod_dir = Fpath.(secrets_dir / "secmod")
-
-let config_data =
- match Assets_crunch.read config_filename with
- | None -> fail "static file not found: `%s`" config_filename
- | Some data ->
- let v = Config_section.parse data in
- v
-
-module Exchange = struct
- let get_opt field = get_opt config_data ~section:"exchange" ~field
- let get field = get config_data ~section:"exchange" ~field
-
- (* - *)
- let currency = (* todo: constraint on currency string *) get "currency"
- let currency_round_unit = get "currency_round_unit" |> amount
- let db = get "db" |> const_value "postgres"
- let attribute_encryption_key = get "attribute_encryption_key"
- let port = get "port" |> int
- let bind_to = get "bind_to"
- let master_public_key = get "master_public_key" |> ed25519
-
- (* TODO Defaults to 0.0 if not specified. *)
- let stefan_abs = get "stefan_abs" |> amount
- let stefan_log = get "stefan_log" |> amount
-
- let stefan_lin =
- get_opt "stefan_lin" |> Option.map float |> Option.value ~default:0.0
-
- let aggregator_idle_sleep_interval =
- get "aggregator_idle_sleep_interval" |> duration
-
- let closer_idle_sleep_interval = get "closer_idle_sleep_interval" |> duration
-
- let transfer_idle_sleep_interval =
- get "transfer_idle_sleep_interval" |> duration
-
- let wirewatch_idle_sleep_interval =
- get "wirewatch_idle_sleep_interval" |> duration
-
- let signkey_legal_duration = get "signkey_legal_duration" |> duration
- let max_keys_caching = get "max_keys_caching" |> duration
- let enable_kyc = get "enable_kyc" |> yes_no
- let terms_etag = get "terms_etag" |> etag
- let privacy_etag = get "privacy_etag" |> etag
- let base_url = get "base_url"
- let shopping_url = get_opt "shopping_url"
- let open_banking_gateway_url = get_opt "open_banking_gateway_url"
- let bank_compliance_language = get_opt "bank_compliance_language"
- let aml_spa_dialect = get_opt "aml_spa_dialect"
- let toplevel_redirect_url = get_opt "toplevel_redirect_url"
- let tiny_amount = get_opt "tiny_amount" |> Option.map amount
-
- (* not implemented or not relevant to MTE:
- let max_requests = get "max_requests" |> int
- aggregator_shard_size
- serve
- unixpath
- unixpath_mode
- terms_dir
- privacy_dir *)
-end
-
-module Exchangedb = struct
- let get field = get config_data ~section:"exchangedb" ~field
-
- (* - *)
- let idle_reserve_expiration_time =
- get "idle_reserve_expiration_time" |> duration
-
- let legal_reserve_expiration_time =
- get "legal_reserve_expiration_time" |> duration
-
- let aggregator_shift = get "aggregator_shift" |> duration
- let max_aml_program_runtime = get "max_aml_program_runtime" |> duration
- let default_purse_limit = get "default_purse_limit" |> int
-end
-
-module Exchangedb_postgres = struct
- let config =
- get config_data ~section:"exchangedb-postgres" ~field:"config" |> uri
-end
-
-module Currency = struct
- type t = {
- enabled: [ `YES | `NO ];
- code: string;
- name: string;
- fractional_input_digits: int;
- fractional_normal_digits: int;
- fractional_trailing_zero_digits: int;
- alt_unit_names: (int * string) list;
- }
-
- let currency_sections =
- List.filter
- (fun v -> String.starts_with ~prefix:"currency-" v.header)
- config_data
-
- let parse_currency section =
- let get field = get config_data ~section:section.header ~field in
- {
- enabled= get "enabled" |> yes_no;
- code= get "code";
- name= get "name";
- fractional_input_digits= get "fractional_input_digits" |> int;
- fractional_normal_digits= get "fractional_normal_digits" |> int;
- fractional_trailing_zero_digits=
- get "fractional_trailing_zero_digits" |> int;
- alt_unit_names=
- get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap;
- }
-
- let all_currencies = List.map parse_currency currency_sections
-
- (* I think the exchange only handle one currency *)
- let v =
- match
- List.find_opt (fun v -> v.code = Exchange.currency) all_currencies
- with
- | None ->
- fail "section `[currency-%s]` not found, currency `%s` is not defined"
- Exchange.currency Exchange.currency
- | Some v -> (
- match v.enabled = `YES with
- | false -> fail "currency `%s` is not enabled" Exchange.currency
- | true -> v)
-end
-
-module Coin = struct
- type t = {
- section_name: string;
- value: Amount.t;
- duration_withdraw: Time.Relative.t;
- duration_spend: Time.Relative.t;
- duration_legal: Time.Relative.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- cipher: [ (* `CS |*) `RSA ];
- rsa_keysize: int; (* : int option (only if `RSA) *)
- age_restricted: [ (*`YES|*) `NO ];
- }
-
- let coin_sections =
- List.filter
- (fun v ->
- (* note: here its a '_' not '-' *)
- String.starts_with ~prefix:"coin_" v.header)
- config_data
-
- let parse_coin section =
- let get field = get config_data ~section:section.header ~field in
- let section_name =
- String.sub section.header 5 (String.length section.header - 5)
- in
- {
- section_name;
- value= get "value" |> amount;
- duration_withdraw= get "duration_withdraw" |> duration;
- duration_spend= get "duration_spend" |> duration;
- duration_legal= get "duration_legal" |> duration;
- fee_withdraw= get "fee_withdraw" |> amount;
- fee_deposit= get "fee_deposit" |> amount;
- fee_refresh= get "fee_refresh" |> amount;
- fee_refund= get "fee_refund" |> amount;
- cipher= (get "cipher" |> const_value "RSA" |> fun _s -> `RSA);
- rsa_keysize= get "rsa_keysize" |> int;
- age_restricted=
- ( get "age_restricted" |> yes_no |> function
- | `NO -> `NO
- | `YES -> fail "`age_restricted = YES` is not supported" );
- }
-
- let all_coins = List.map parse_coin coin_sections
-end
-
-module Exchange_secmod_rsa = struct
- let get field =
- let section = "taler-exchange-secmod-" ^ "rsa" in
- get config_data ~section ~field
-
- let lookahead_sign = get "lookahead_sign" |> duration
- let overlap_duration = get "overlap_duration" |> duration
- (* not relevant: sm_priv_key key_dir unixpath *)
-end
-
-module Exchange_secmod_eddsa = struct
- let get field =
- let section = "taler-exchange-secmod-" ^ "eddsa" in
- get config_data ~section ~field
-
- let lookahead_sign = get "lookahead_sign" |> duration
- let overlap_duration = get "overlap_duration" |> duration
-end
-
-(* -- *)
-include Exchange
diff --git a/.jjconflict-side-0/src/crypto.ml b/.jjconflict-side-0/src/crypto.ml
deleted file mode 100644
index 99cabfea..00000000
--- a/.jjconflict-side-0/src/crypto.ml
+++ /dev/null
@@ -1,371 +0,0 @@
-open Syntax
-
-module Binary_format_rsa = struct
- (* RSA public key binary format
- https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html
- := { uint16_be: n size; uint16_be: e size; n; e}
-
- integer in big-endian format (MSB first)
- leading zeroes are stripped unless they are required to keep a value positive
- no 0-termination *)
-
- let z_array_to_octets (arr : Z.t array) =
- let nb = Array.length arr in
- let bits_arr = Array.map Mirage_crypto_pk.Z_extra.to_octets_be arr in
- let len_arr = Array.map String.length bits_arr in
- let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
- let b = Bytes.make len '\x00' in
- let pos = ref 0 in
- Array.iter
- (fun len ->
- Bytes.set_uint16_be b !pos len;
- pos := !pos + 2)
- len_arr;
- Array.iteri
- (fun i bits ->
- let len = len_arr.(i) in
- Bytes.blit_string bits 0 b !pos len;
- pos := !pos + len)
- bits_arr;
- Bytes.unsafe_to_string b
-
- let z_array_of_octets ~nb s =
- let s_len = String.length s in
- if s_len <= 2 * nb then Error "rsa of_octets error"
- else
- let pos = ref 0 in
- let len_arr =
- Array.init nb (fun _i ->
- let len = String.get_uint16_be s !pos in
- pos := !pos + 2;
- len)
- in
- let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
- if s_len <> len then Error "rsa of_octets error"
- else
- let z_arr =
- Array.init nb (fun i ->
- let len = len_arr.(i) in
- let s = String.sub s !pos len in
- let z = Mirage_crypto_pk.Z_extra.of_octets_be s in
- pos := !pos + len;
- z)
- in
- Ok z_arr
-
- let pub_to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) =
- z_array_to_octets [| n; e |]
-
- let pub_of_octets s =
- let* arr = z_array_of_octets ~nb:2 s in
- match arr with
- | [| n; e |] ->
- let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg in
- pub
- | _ -> assert false
-
- (* custom private key binary format <> than gcrypt *)
- let priv_to_octets ({ e; d; n; p; q; dp; dq; q' } : Mirage_crypto_pk.Rsa.priv)
- =
- z_array_to_octets [| e; d; n; p; q; dp; dq; q' |]
-
- let priv_of_octets s =
- let* arr = z_array_of_octets ~nb:8 s in
- match arr with
- | [| e; d; n; p; q; dp; dq; q' |] ->
- let+ priv =
- Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_err_msg
- in
- priv
- | _ -> assert false
-end
-
-module EddsaPublicKey = struct
- open Mirage_crypto_ec.Ed25519
-
- type t = pub
-
- let to_octets t = pub_to_octets t
-
- let of_octets t =
- pub_of_octets t |> function
- | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
- | Ok v -> Ok v
-
- let bin =
- let of_octets_exn t = of_octets t |> Result.get_ok in
- Bin.map (Bin.bytes 32) of_octets_exn to_octets
-
- let of_b32 s =
- let* octets = B32.decode s in
- let* pub = of_octets octets in
- Ok pub
-
- let to_b32 t = B32.encode (to_octets t)
- let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
-
- let caqti =
- Caqti_type.custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> of_octets v)
- Caqti_type.octets
-end
-
-module EddsaPrivateKey = struct
- (* EdDSA and ECDHE public keys always point on Curve25519
- and represented using the standard 256 bits Ed25519 compact format,
- converted to Crockford Base32. *)
- open Mirage_crypto_ec.Ed25519
-
- type t = priv
-
- let pub_of_priv = pub_of_priv
- let to_octets t = priv_to_octets t
-
- let of_octets t =
- priv_of_octets t |> function
- | Error err ->
- let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in
- Error err
- | Ok v -> Ok v
-
- let bin =
- let of_octets_exn t = of_octets t |> Result.get_ok in
- Bin.map (Bin.bytes 32) of_octets_exn to_octets
-
- let jsont =
- let of_b32 s =
- let* octets = B32.decode s in
- of_octets octets
- in
- let to_b32 t = B32.encode (to_octets t) in
- Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
-end
-
-module EddsaSignature : sig
- type t
-
- val sign : key:EddsaPrivateKey.t -> string -> t
-
- (* Ok () on verification success *)
- val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result
- val to_octets : t -> string
- val of_octets : string -> (t, string) result
- val jsont : t Jsont.t
- val bin : t Bin.t
- val caqti : t Caqti_type.t
-end = struct
- (* transmitted as 64-bytes base32
- binary-encoded objects with just the R and S values *)
- type t = string
-
- (* mirage_crypto:
- "The result is the concatenation of r and s, as specified in RFC 8032." *)
- let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s
-
- let verify ~key s ~msg =
- let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in
- match b with
- | false -> Error "EddsaSignature verification: invalid signature"
- | true -> Ok ()
-
- let to_octets t = t
-
- let check_size t =
- match String.length t = 64 with
- | false -> Error "EddsaSignature of_octets: data is not 64 bytes."
- | true -> Ok ()
-
- let of_octets v =
- let+ () = check_size v in
- v
-
- let bin =
- let of_octets_exn t = of_octets t |> Result.get_ok in
- Bin.map (Bin.bytes 64) of_octets_exn to_octets
-
- let jsont =
- let of_b32 s =
- let* t = B32.decode s in
- of_octets t
- in
- let to_b32 = B32.encode in
- Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
-
- let caqti =
- Caqti_type.custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun s -> of_octets s)
- Caqti_type.octets
-end
-
-module RsaPublicKey = struct
- open Mirage_crypto_pk
-
- type t = Rsa.pub
-
- let to_octets = Binary_format_rsa.pub_to_octets
- let of_octets = Binary_format_rsa.pub_of_octets
-
- let jsont =
- let of_b32 s =
- let* s = B32.decode s in
- let+ v = of_octets s in
- v
- in
- let to_b32 t = B32.encode (to_octets t) in
- Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
-
- let caqti : t Caqti_type.t =
- Caqti_type.custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> of_octets v)
- Caqti_type.octets
-end
-
-module RsaPrivateKey = struct
- open Mirage_crypto_pk.Rsa
-
- type t = priv
-
- let generate ~bits () =
- let priv = generate ~bits () in
- let pub = pub_of_priv priv in
- (priv, pub)
-
- let pub_of_priv = pub_of_priv
- let of_octets = Binary_format_rsa.priv_of_octets
- let to_octets = Binary_format_rsa.priv_to_octets
-
- let jsont =
- let of_b32 s =
- let* s = B32.decode s in
- let+ v = of_octets s in
- v
- in
- let to_b32 t = B32.encode (to_octets t) in
- Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
-end
-
-module RsaSignature : sig
- type t
-
- val jsont : t Jsont.t
-end = struct
- type t = string
-
- let jsont =
- let of_b32 s = B32.decode s in
- let to_b32 t = B32.encode t in
- Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
-end
-
-(* some type aliases, just for prettier .mli *)
-type eddsa_priv = EddsaPrivateKey.t
-type eddsa_pub = EddsaPublicKey.t
-type eddsa_sig = EddsaSignature.t
-type rsa_priv = RsaPrivateKey.t
-type rsa_pub = RsaPublicKey.t
-type rsa_sig = RsaSignature.t
-type denom_hash = Hash.DenominationHash.t
-
-(* WIP *)
-module FDH_RSA = struct
- open Mirage_crypto_pk
-
- module Kdf = struct
- module XTR = Hkdf.Make (Digestif.SHA512)
- module PRF = Hkdf.Make (Digestif.SHA256)
-
- let kdf =
- fun ~xts ~ikm ~ctx ~len ->
- let prk = XTR.extract ~salt:xts ikm in
- let okm = PRF.expand ~prk ~info:ctx len in
- okm
-
- let kdf_mod_n ~n ~xts ~ikm ~ctx =
- let nbits = Z.numbits n in
- let len = ((nbits - 1) / 8) + 1 in
- assert (8 * len = nbits);
- let rec go ctr =
- (* cat ctx ctr_be *)
- let ctx =
- let ctx_len = String.length ctx in
- let b = Bytes.create (ctx_len + 2) in
- Bytes.blit_string ctx 0 b 0 ctx_len;
- Bytes.set_uint16_be b ctx_len ctr;
- Bytes.unsafe_to_string b
- in
- let okm = kdf ~xts ~ikm ~ctx ~len in
- assert (String.length okm = len);
- let r = Z_extra.of_octets_be okm in
- if Z.gt r n then go (succ ctr) else r
- in
- go 0
- end
-
- let gcd_validate r n =
- match Z.equal (Z.gcd r n) Z.one with
- | true -> ()
- | false -> Fmt.failwith "RSA key is malicious"
-
- let rsa_full_domain_hash pub msg =
- let xts = RsaPublicKey.to_octets pub in
- let ctx = "RSA-FDA FTpsW!" in
- let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:msg ~ctx in
- gcd_validate r pub.n; r
-
- let rsa_blinding_key_derive (pub : RsaPublicKey.t) bks =
- let xts = "Blinding KDF extractor HMAC key" in
- let ctx = "Blinding KDF" in
- let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:bks ~ctx in
- gcd_validate r pub.n; r
-
- let rsa_blind pub ~bks ~msg =
- let data = rsa_full_domain_hash pub msg in
- let bkey = rsa_blinding_key_derive pub bks in
- (* can we just use [powm] here instead? *)
- let r_e = Z.powm_sec bkey pub.e pub.n in
- let data_r_e = Z.rem (Z.mul data r_e) pub.n in
- Z_extra.to_octets_be data_r_e
-
- (* -- WIP crypto -- *)
-
- (* TODO crypto
- not sure about signature scheme used by taler
- libgnunetutil crypto_rsa.c use "(flags raw)" => no padding *)
- (* decrypt <=> sign *)
- let rsa_sign_z priv r =
- let data = Z_extra.to_octets_be r in
- Rsa.decrypt ~crt_hardening:true ~key:priv data
-
- (* TODO crypto
- look into mirage-crypto for this
- use Eqaf for constant time string compare *)
- let rsa_verify_z pub r sig_ =
- let data = Z_extra.to_octets_be r in
- let sig_' = Rsa.encrypt ~key:pub data in
- match String.equal sig_ sig_' with
- | false -> Fmt.error "RSA signature verification failed"
- | true -> Ok ()
-
- let rsa_sign_fdh priv msg =
- let pub = Rsa.pub_of_priv priv in
- let r = rsa_full_domain_hash pub msg in
- rsa_sign_z priv r
-
- let rsa_unblind pub ~bks ~sig_ =
- let bkey = rsa_blinding_key_derive pub bks in
- let r_inv =
- try Z.invert bkey pub.n
- with Division_by_zero ->
- (* => gcd(r,n) <> 1, should be already checked for *)
- assert false
- in
- let ubsig = Z.rem (Z.mul sig_ r_inv) pub.n in
- ubsig
-
- let rsa_verify pub ~msg ~sig_ =
- let r = rsa_full_domain_hash pub msg in
- rsa_verify_z pub r sig_
-end
diff --git a/.jjconflict-side-0/src/denomination.ml b/.jjconflict-side-0/src/denomination.ml
deleted file mode 100644
index c8b8603e..00000000
--- a/.jjconflict-side-0/src/denomination.ml
+++ /dev/null
@@ -1,18 +0,0 @@
-open Crypto
-
-type t = {
- pub: rsa_pub;
- value: Amount.t;
- stamp_start: Timestamp.t;
- stamp_expire_withdraw: Timestamp.t;
- stamp_expire_deposit: Timestamp.t;
- stamp_expire_legal: Timestamp.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- age_mask: int;
- h_pub: denom_hash;
- master_sig: Signatures.DenominationKeyValidity.t;
- revoked_sig: Signatures.MasterDenominationKeyRevocation.t option;
-}
diff --git a/.jjconflict-side-0/src/devices.ml b/.jjconflict-side-0/src/devices.ml
deleted file mode 100644
index 1d3c702b..00000000
--- a/.jjconflict-side-0/src/devices.ml
+++ /dev/null
@@ -1,26 +0,0 @@
-type env = {
- caqti_switch: Caqti_miou.Switch.t;
- db_uri: Uri.t;
-}
-
-let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
- let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
- Vif.Device.v ~name:"db_connection" ~finally []
- @@ fun { caqti_switch; db_uri } ->
- match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
- | Error err ->
- Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
- | Ok conn -> (
- match Pg.preflight conn with
- | Error err ->
- Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
- | Ok () ->
- Logs.info (fun m -> m "database connection initialized");
- conn)
-
-let keys =
- let finally _key = () in
- Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ]
- @@ fun (module Conn : Pg.CONN) (_env : env) ->
- let sm : (module Keys.S) = (module Keys.Make (Conn)) in
- sm
diff --git a/.jjconflict-side-0/src/dune b/.jjconflict-side-0/src/dune
deleted file mode 100644
index 0a6fa0ea..00000000
--- a/.jjconflict-side-0/src/dune
+++ /dev/null
@@ -1,45 +0,0 @@
-(executable
- (public_name mte)
- (name mte)
- (modules mte)
- (libraries mte))
-
-(library
- (name mte)
- (wrapped false)
- (modules :standard \ mte b32)
- (libraries
- b32
- ;
- caqti
- caqti-miou
- caqti-miou.unix
- caqti-driver-pgx
- bin
- mirage-crypto
- kdf.hkdf
- digestif
- duration
- vif
- fmt
- jsont
- cohttp
- ptime
- logs
- logs.fmt
- logs.threaded
- fmt.tty))
-
-(library ; crockford base32
- (name b32)
- (modules b32)
- (libraries base32))
-
-(rule
- (target assets_crunch.ml)
- (deps
- (source_tree ../assets))
- (action
- (with-stdout-to
- %{null}
- (run ocaml-crunch -m plain ../assets -o %{target}))))
diff --git a/.jjconflict-side-0/src/hash.ml b/.jjconflict-side-0/src/hash.ml
deleted file mode 100644
index ef1f4e10..00000000
--- a/.jjconflict-side-0/src/hash.ml
+++ /dev/null
@@ -1,103 +0,0 @@
-open Digestif
-
-module type S = sig
- type t
-
- val bin : t Bin.t
- val caqti : t Caqti_type.t
- val jsont : t Jsont.t
- val hash : string -> t
- val of_octets : string -> t
- val to_octets : t -> string
- val of_b32 : B32.t -> (t, string) result
-end
-
-module H32 = struct
- type t = SHA256.t
-
- let hash s = SHA256.(digest_string s)
-
- let of_octets s =
- match SHA256.of_raw_string_opt s with
- | None -> Fmt.failwith "H32.of_octets failure"
- | Some t -> t
-
- let to_octets = SHA256.to_raw_string
- let of_b32 s = Result.map of_octets (B32.decode s)
-
- let bin =
- let open Bin in
- map (bytes 32) of_octets to_octets
-
- (* hashes are not b32 encoded in the database *)
- let caqti =
- let open Caqti_type in
- custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> Ok (of_octets v))
- octets
-
- let jsont =
- let enc v = B32.encode (to_octets v) in
- Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc
-end
-
-module H64 = struct
- type t = SHA512.t
-
- let hash s = SHA512.(digest_string s)
-
- let of_octets s =
- match SHA512.of_raw_string_opt s with
- | None -> Fmt.failwith "H64.of_octets failure"
- | Some t -> t
-
- let to_octets = SHA512.to_raw_string
- let of_b32 s = Result.map of_octets (B32.decode s)
-
- let bin =
- let open Bin in
- map (bytes 64) of_octets to_octets
-
- (* hashes are not b32 encoded in the database *)
- let caqti =
- let open Caqti_type in
- custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> Ok (of_octets v))
- octets
-
- let jsont =
- let enc v = B32.encode (to_octets v) in
- Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc
-end
-
-(* C-terminated strings
- some strings need to be hashed with a '\0' termination char *)
-module Cstring = struct
- module H32 = struct
- include H32
-
- let hash s = hash (s ^ "\x00")
- end
-
- module H64 = struct
- include H64
-
- let hash s = hash (s ^ "\x00")
- end
-end
-
-(* TODO
- check which hash algorithm to use for each hash type *)
-module FullPaytoHash : S = H32
-module NormalizedPaytoHash : S = H32
-module DenominationHash : S = H64
-module PrivateContractHash : S = H64
-module ExtensionsPolicyHash : S = H64
-module MerchantWireHash : S = H64
-module AgeCommitmentHash : S = H64
-module BlindedCoinHash : S = H64
-module CoinPubHash : S = H64
-module OutputCommitmentHash : S = H64
-module HashPlanchetsP : S = H64
diff --git a/.jjconflict-side-0/src/headers.ml b/.jjconflict-side-0/src/headers.ml
deleted file mode 100644
index fd6ebfc7..00000000
--- a/.jjconflict-side-0/src/headers.ml
+++ /dev/null
@@ -1,44 +0,0 @@
-let accept_header_value =
- Fmt.str "%a"
- (Fmt.array ~sep:(Fmt.any ", ") Assets.Mimetype.pp)
- Assets.Mimetype.arr
-
-let avail_languages_header_value =
- Fmt.str "%a" (Fmt.array ~sep:(Fmt.any ", ") Fmt.string) Assets.Language.arr
-
-(* TODO Cohttp raises on invalid *)
-let select_mimetype headers =
- let opt = Vif.Headers.get headers "accept" in
- Cohttp.Accept.media_ranges opt
- |> Cohttp.Accept.qsort
- |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp m)
- |> function
- | None -> Assets.Mimetype.default
- | Some mime -> mime
-
-let select_language headers =
- let opt = Vif.Headers.get headers "accept-language" in
- Cohttp.Accept.languages opt
- |> Cohttp.Accept.qsort
- |> List.map snd
- |> List.find_map Assets.Language.of_cohttp
- |> function
- | None -> Assets.Language.default
- | Some lang -> lang
-
-let select_encoding headers =
- let opt = Vif.Headers.get headers "accept-encoding" in
- Cohttp.Accept.encodings opt
- |> Cohttp.Accept.qsort
- |> List.map snd
- |> List.find_map (function
- | Cohttp.Accept.Identity -> Some `Identity
- | Deflate -> Some `DEFLATE
- | Gzip -> Some `Gzip
- | AnyEncoding -> Some Assets.Assets_config.default_encoding
- | Encoding _ | Compress -> (* unsupported *) None)
- |> function
- | None -> None
- | Some `Identity -> None
- | Some `DEFLATE -> Some `DEFLATE
- | Some `Gzip -> Some `Gzip
diff --git a/.jjconflict-side-0/src/headers_lib.ml b/.jjconflict-side-0/src/headers_lib.ml
deleted file mode 100644
index e76a589a..00000000
--- a/.jjconflict-side-0/src/headers_lib.ml
+++ /dev/null
@@ -1,69 +0,0 @@
-module Etag = struct
- (* https://httpwg.org/specs/rfc9110.html#field.etag *)
-
- type t = {
- weak: bool;
- value: string;
- }
-
- let pp ppf { weak; value } =
- match weak with
- | false -> Fmt.pf ppf {|"%s"|} value
- | true -> Fmt.pf ppf {|W/"%s"|} value
-
- let to_field_string t = Fmt.str "%a" pp t
-
- let angstrom =
- let open Angstrom in
- let is_valid_char c =
- let n = Char.code c in
- (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
- in
- let quoted_string = char '"' *> take_while is_valid_char <* char '"' in
- lift2
- (fun weak value -> { weak; value })
- (option false (string "W/" *> return true))
- quoted_string
-
- let parse s =
- match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
- | Error _e -> Fmt.error "invalid etag: `%s`" s
- | Ok v -> Ok v
-end
-
-module If_none_match = struct
- type t =
- | Any
- | List of Etag.t list
-
- let pp ppf = function
- | Any -> Fmt.pf ppf {|*|}
- | List l -> Fmt.pf ppf {|%a|} (Fmt.list ~sep:(Fmt.any ", ") Etag.pp) l
-
- let angstrom =
- let open Angstrom in
- let ows = skip_while (function ' ' | '\t' -> true | _ -> false) in
- let comma = ows *> char ',' *> ows in
- (* A recipient MUST parse and ignore a reasonable number of empty list elements *)
- let etag_opt = Etag.angstrom >>| Option.some <|> return None in
- let etags =
- etag_opt >>= fun hd ->
- many (comma *> etag_opt) >>= fun tl ->
- let l = List.filter_map Fun.id (hd :: tl) in
- match l with [] -> fail "empty etag list" | l -> return (List l)
- in
- let any = char '*' *> return Any in
- any <|> etags
-
- let parse s =
- match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
- | Error _e -> Fmt.error "invalid if-none-match field: `%s`" s
- | Ok v -> Ok v
-
- let evaluate etag t =
- match t with
- | Any -> false
- | List l ->
- not
- @@ List.exists (fun e -> String.equal etag.Etag.value e.Etag.value) l
-end
diff --git a/.jjconflict-side-0/src/http_information.ml b/.jjconflict-side-0/src/http_information.ml
deleted file mode 100644
index 6c4068d9..00000000
--- a/.jjconflict-side-0/src/http_information.ml
+++ /dev/null
@@ -1,254 +0,0 @@
-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.ok 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
- Denomination.
- {
- 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 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 Keys : Keys.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 dn_l =
- (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
- Keys.get_denominations ()
- |>
- (* reverse chronological order *)
- List.sort (fun a b ->
- Stdlib.compare b.Denomination.stamp_start a.stamp_start)
- in
- let list_issue_date =
- match dn_l with
- | [] -> Timestamp.never
- | dn :: _ -> dn.Denomination.stamp_start
- in
- let denominations =
- (* if `?last_issue_date` query param does not exactly match the `stamp_start`
- of one of the denomination keys, all keys are returned *)
- let open Denomination in
- let l =
- match last_issue_date with
- | None -> dn_l
- | Some last_issue_date -> (
- match
- List.find_opt
- (fun v -> Timestamp.compare v.stamp_start last_issue_date = 0)
- dn_l
- with
- | None -> dn_l
- | Some _ ->
- List.filter
- (fun v ->
- Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
- dn_l)
- in
- List.map denomgroup_of_denomdata l
- in
-
- let signkeys =
- (*
- let now = Ptime_clock.now () |> Option.some in
- let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
- Keys.get_signkeys ()
- |> List.sort (fun a b ->
- let open Signkey in
- Stdlib.compare b.stamp_start a.stamp_start)
- |> List.map Api.SignKey.of_signkey
- in
-
- let exchange_pub =
- (* the eddsa pub key used to sign exchange_sig *)
- match signkeys with
- | [] -> Fmt.failwith "exchange has no active signkey"
- | sk :: _ -> sk.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 =
- dn_l
- |> List.map (fun dn -> dn.Denomination.master_sig)
- |> List.map Signatures.DenominationKeyValidity.to_octets
- |> String.concat ""
- |> Hash.H64.hash
- in
- let open Signatures.ExchangeKeySet in
- sign_f
- ~f:(Keys.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 keys = Vif.Server.device Devices.keys 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 keys ~last_issue_date in
- let s = Api.encode_exn jsont v in
- Ok s
- in
- Respond.result res req
diff --git a/.jjconflict-side-0/src/http_management.ml b/.jjconflict-side-0/src/http_management.ml
deleted file mode 100644
index 9ba83b1b..00000000
--- a/.jjconflict-side-0/src/http_management.ml
+++ /dev/null
@@ -1,637 +0,0 @@
-open Syntax
-open Api
-open Hash
-
-module Keys_get = struct
- let mk_future_keys_response (module Keys : Keys.S) =
- let future_signkeys = Keys.get_future_signkeys () in
- let future_denoms = Keys.get_future_denominations () in
- let master_pub = Config.Exchange.master_public_key in
- let denom_secmod_public_key = Keys.sm_pubkey in
- let signkey_secmod_public_key = Keys.sm_pubkey in
- FutureKeysResponse.
- {
- future_denoms;
- future_signkeys;
- master_pub;
- denom_secmod_public_key;
- signkey_secmod_public_key;
- }
-
- let jsont = FutureKeysResponse.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "GET /management/keys/");
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let v = mk_future_keys_response sm in
- let s = Api.encode_exn jsont v in
- Ok s
- in
- Respond.result res req
-end
-
-module Keys_post = struct
- let error_key_unknown =
- "404 not found, One of the keys for which a signature was provided is \
- unknown to the exchange."
-
- let verify_denom_signature (module Keys : Keys.S)
- DenomSignature.{ h_denom_pub; master_sig } =
- let* denom =
- Keys.find_future_denomination h_denom_pub
- |> Option.to_result ~none:error_key_unknown
- in
- let open Signatures.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;
- fee_refund= denom.fee_refund;
- denom_hash= h_denom_pub;
- }
- in
- verify_f ~f:Keys.verify_with_master_key master_sig r
-
- let verify_signkey_signature (module Keys : Keys.S)
- SignKeySignature.{ key; master_sig } =
- let* signkey =
- Keys.find_future_signkey key |> Option.to_result ~none:error_key_unknown
- in
- let open Signatures.ExchangeSigningKeyValidity in
- let r : r =
- {
- start= signkey.stamp_start;
- expire= signkey.stamp_expire;
- end_= signkey.stamp_end;
- signkey_pub= signkey.key;
- }
- in
- verify_f ~f:Keys.verify_with_master_key master_sig r
-
- let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } =
- let* () = list_iter (verify_denom_signature sm) denom_sigs in
- let* () = list_iter (verify_signkey_signature sm) signkey_sigs in
- Ok ()
-
- let do_ ~db_conn:_ (module Keys : Keys.S)
- MasterSignatures.{ denom_sigs; signkey_sigs } =
- let* () =
- list_iter
- (fun SignKeySignature.{ key; master_sig } ->
- Keys.certify_future_signkey key ~master_sig)
- signkey_sigs
- in
- let* () =
- list_iter
- (fun DenomSignature.{ h_denom_pub; master_sig } ->
- Keys.certify_future_denomination h_denom_pub ~master_sig)
- denom_sigs
- in
- let* () = Keys.save () in
- Ok ()
-
- let jsont = MasterSignatures.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/keys/");
- let db_conn = Vif.Server.device Devices.db_connection server in
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn sm v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Denom_revoke = struct
- let verify (module Keys : Keys.S) h_denom_pub
- DenomRevocationSignature.{ master_sig } =
- let open Signatures.MasterDenominationKeyRevocation in
- verify_f ~f:Keys.verify_with_master_key master_sig { h_denom_pub }
-
- let do_ ~db_conn (module Keys : Keys.S) h_denom_pub
- DenomRevocationSignature.{ master_sig } =
- let* () = Keys.revoke_denomination h_denom_pub master_sig in
- let+ () =
- Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
- |> unwrap_err_caqti
- in
- ()
-
- let jsont = DenomRevocationSignature.jsont
-
- let f req h_denom_pub server _env =
- Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
- let db_conn = Vif.Server.device Devices.db_connection server in
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm h_denom_pub v in
- let* () = do_ ~db_conn sm h_denom_pub v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Signkey_revoke = struct
- let verify (module Keys : Keys.S) exchange_pub
- SignkeyRevocationSignature.{ master_sig } =
- let open Signatures.MasterSigningKeyRevocation in
- verify_f ~f:Keys.verify_with_master_key master_sig { exchange_pub }
-
- let do_ ~db_conn (module Keys : Keys.S) exchange_pub
- SignkeyRevocationSignature.{ master_sig } =
- let* () = Keys.revoke_signkey exchange_pub master_sig in
- let+ () =
- Pg.insert_signkey_revocation db_conn exchange_pub master_sig
- |> unwrap_err_caqti
- in
- ()
-
- let jsont = SignkeyRevocationSignature.jsont
-
- let f req exchange_pub server _env =
- Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
- let db_conn = Vif.Server.device Devices.db_connection server in
- let sm = Vif.Server.device Devices.secmod server in
- let res =
- let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm exchange_pub v in
- let* () = do_ ~db_conn sm exchange_pub v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Auditors = struct
- let verify (module Keys : Keys.S)
- AuditorSetupMessage.
- {
- auditor_url;
- auditor_name= _;
- auditor_pub;
- master_sig;
- validity_start;
- } =
- let open Signatures.MasterAddAuditor in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- start_date= validity_start;
- auditor_pub;
- h_auditor_url= Hash.Cstring.H64.hash auditor_url;
- }
-
- (* TODO monotonic time *)
- let do_ ~db_conn v =
- let auditor_pub = v.AuditorSetupMessage.auditor_pub in
- let validity_start = v.AuditorSetupMessage.validity_start in
- let* last_date_opt =
- Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
- in
- match last_date_opt with
- | None ->
- let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "enabled auditor");
- ()
- | Some last_date ->
- if Timestamp.compare last_date validity_start > 0 then
- Error
- "database has more recent auditor data for this auditor public key"
- else
- let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "updated auditor");
- ()
-
- let jsont = AuditorSetupMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/auditors/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Auditors_disable = struct
- let verify (module Keys : Keys.S) auditor_pub
- AuditorTeardownMessage.{ master_sig; validity_end } =
- let open Signatures.MasterDelAuditor in
- verify_f ~f:Keys.verify_with_master_key master_sig
- { end_date= validity_end; auditor_pub }
-
- let do_ ~db_conn auditor_pub
- AuditorTeardownMessage.{ master_sig= _; validity_end } =
- let* last_date_opt =
- Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
- in
- match last_date_opt with
- | None -> Error "auditor not found"
- | Some last_date ->
- if Timestamp.compare last_date validity_end > 0 then
- Error
- "database has more recent auditor data for this auditor public key"
- else
- let+ () =
- Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
- |> unwrap_err_caqti
- in
- ()
-
- let jsont = AuditorTeardownMessage.jsont
-
- let f req auditor_pub server _env =
- Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm auditor_pub v in
- let* () = do_ ~db_conn auditor_pub v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Wire_fee = struct
- let verify (module Keys : Keys.S)
- WireFeeSetupMessage.
- {
- wire_method;
- master_sig_wire;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- } =
- let open Signatures.MasterWireFee in
- verify_f ~f:Keys.verify_with_master_key master_sig_wire
- {
- h_wire_method= Hash.Cstring.H64.hash wire_method;
- start_date= fee_start;
- end_date= fee_end;
- wire_fee;
- closing_fee;
- }
-
- let do_ ~db_conn (v : WireFeeSetupMessage.t) =
- let* wire_fees =
- Pg.get_wire_fees_by_time db_conn ~wire_method:v.wire_method
- ~start_date:v.fee_start ~end_date:v.fee_end
- |> unwrap_err_caqti
- in
- match wire_fees with
- | [] ->
- let+ () = Pg.insert_wire_fee db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "added wire fee");
- ()
- | [ vv ] -> (
- match v.master_sig_wire = vv.sig_ with
- | false ->
- Error "a different wire-fee was already setup for this time frame"
- | true ->
- Logs.info (fun m -> m "an identical wire-fee was already setup");
- Ok ())
- | _ ->
- Error
- "invalid database state, multiple wire-fee found in database for \
- this time frame"
-
- let jsont = WireFeeSetupMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/wire-fee/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Global_fees = struct
- let verify (module Keys : Keys.S)
- GlobalFees.
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- } =
- let open Signatures.GlobalFees in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- }
-
- let do_ ~db_conn v =
- let* global_fees =
- let start_date = v.GlobalFees.start_date in
- let end_date = v.GlobalFees.end_date in
- Pg.get_global_fees_by_time db_conn ~start_date ~end_date
- |> unwrap_err_caqti
- in
- match global_fees with
- | [] ->
- let+ () = Pg.insert_global_fees db_conn v |> unwrap_err_caqti in
- Logs.info (fun m -> m "added global fees");
- ()
- | [ vv ] -> (
- match v.master_sig = vv.master_sig with
- | false ->
- Error
- "a different global-fees was already setup for this time frame"
- | true ->
- Logs.info (fun m -> m "an identical global-fees was already setup");
- Ok ())
- | _ ->
- Error
- "invalid database state, multiple global-fees found in database for \
- this time frame"
-
- let jsont = GlobalFees.jsont
-
- (* TODO better global_fees
- ensure it is defined for the current time.
- there should be only one global_fees for each moment in time
- and once set for a timeframe, it should not change. *)
- let f req server _env =
- Logs.info (fun m -> m "POST /management/global-fees/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Wire = struct
- let verify (module Keys : Keys.S)
- WireSetupMessage.
- {
- payto_uri;
- master_sig_wire;
- master_sig_add;
- validity_start;
- bank_label= _;
- priority= _;
- } =
- (* TODO are those read from payto_uri? *)
- let conversion_url = "" in
- let credit_restrictions = "" in
- let debit_restrictions = "" in
- let* () =
- let open Signatures.MasterWireDetails in
- verify_f ~f:Keys.verify_with_master_key master_sig_wire
- {
- h_wire_details= FullPaytoHash.hash payto_uri;
- h_conversion_url= Hash.Cstring.H64.hash conversion_url;
- h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
- h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
- }
- in
- let* () =
- let open Signatures.MasterAddWire in
- verify_f ~f:Keys.verify_with_master_key master_sig_add
- {
- start_date= validity_start;
- h_wire= FullPaytoHash.hash payto_uri;
- h_conversion_url= Hash.Cstring.H64.hash conversion_url;
- h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
- h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
- }
- in
- Ok ()
-
- let do_ ~db_conn v =
- let* last_change_opt =
- let payto_uri = v.WireSetupMessage.payto_uri in
- Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
- in
- match last_change_opt with
- | Some _ -> Error "wire already setup"
- | None ->
- let r =
- ExchangeWireAccount.
- {
- payto_uri= v.payto_uri;
- conversion_url= None;
- debit_restrictions= [];
- credit_restrictions= [];
- master_sig= v.master_sig_wire;
- bank_label= v.bank_label;
- priority= v.priority;
- }
- in
- let+ () =
- Pg.insert_wire db_conn ~last_change:v.validity_start r
- |> unwrap_err_caqti
- in
- ()
-
- let jsont = WireSetupMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/wire/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Wire_disable = struct
- let verify (module Keys : Keys.S)
- WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
- let open Signatures.MasterDelWire in
- verify_f ~f:Keys.verify_with_master_key master_sig_del
- { end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri }
-
- let do_ ~db_conn
- WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
- let* last_change_opt =
- Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
- in
- match last_change_opt with
- | None -> Error "wire not found"
- | Some _ ->
- let+ () =
- Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
- in
- ()
-
- let jsont = WireTeardownMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/wire/disable/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Drain = struct
- let verify (module Keys : Keys.S)
- DrainProfitsMessage.
- {
- debit_account_section;
- credit_payto_uri;
- wtid;
- master_sig;
- date;
- amount;
- } =
- let open Signatures.MasterDrainProfit in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- wtid;
- date;
- amount;
- h_section= Hash.Cstring.H64.hash debit_account_section;
- h_payto= FullPaytoHash.hash credit_payto_uri;
- }
-
- let do_ ~db_conn v =
- let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
- ()
-
- let jsont = DrainProfitsMessage.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/drain/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module AmlOfficer = struct
- let verify (module Keys : Keys.S)
- AmlOfficerSetup.
- {
- officer_pub;
- officer_name;
- is_active;
- read_only= _;
- master_sig;
- change_date;
- } =
- let open Signatures.MasterAmlOfficerStatus in
- let is_active = match is_active with true -> 1_l | false -> 0_l in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- change_date;
- officer_pub;
- h_officer_name= Hash.Cstring.H64.hash officer_name;
- is_active;
- }
-
- let do_ ~db_conn v =
- let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_err_caqti in
- ()
-
- let jsont = AmlOfficerSetup.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/aml-officers/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
-
-module Partners = struct
- let verify (module Keys : Keys.S)
- ExchangePartnerSetupRequest.
- {
- partner_base_url;
- partner_pub;
- wad_frequency;
- master_sig;
- start_date;
- end_date;
- wad_fee;
- } =
- let open Signatures.PartnerConfiguration in
- verify_f ~f:Keys.verify_with_master_key master_sig
- {
- partner_pub;
- start_date;
- end_date;
- wad_frequency;
- wad_fee;
- h_url= Hash.Cstring.H64.hash partner_base_url;
- }
-
- let do_ ~db_conn v =
- let+ () = Pg.insert_partner db_conn v |> unwrap_err_caqti in
- ()
-
- let jsont = ExchangePartnerSetupRequest.jsont
-
- let f req server _env =
- Logs.info (fun m -> m "POST /management/partners/");
- let sm = Vif.Server.device Devices.secmod server in
- let db_conn = Vif.Server.device Devices.db_connection server in
- let res =
- let* v = Vif.Request.of_json req |> unwrap_err_msg in
- let* () = verify sm v in
- let* () = do_ ~db_conn v in
- Ok ""
- in
- Respond.result res req
-end
diff --git a/.jjconflict-side-0/src/http_terms.ml b/.jjconflict-side-0/src/http_terms.ml
deleted file mode 100644
index 4dca972a..00000000
--- a/.jjconflict-side-0/src/http_terms.ml
+++ /dev/null
@@ -1,49 +0,0 @@
-(* /terms + /privacy *)
-
-let aux asset req _server _env =
- let etag = Assets.etag asset in
- let headers = Vif.Request.headers req in
- let has_matching_etag =
- match Vif.Headers.get headers "if-none-match" with
- | None -> Ok false
- | Some s ->
- Headers_lib.If_none_match.parse s
- |> Result.map (Headers_lib.If_none_match.evaluate etag)
- in
- match has_matching_etag with
- | Error e -> Respond.bad_request ~hint:e req
- | Ok true -> Respond.not_modified ()
- | Ok false ->
- let mime = Headers.select_mimetype headers in
- let lang = Headers.select_language headers in
- let compression = Headers.select_encoding headers in
- let data = Assets.get_content ~mime ~lang asset in
- (* -- *)
- let open Vif.Response in
- let open Syntax in
- let* () = with_string ?compression req data in
- let* () =
- let etag_field_value = Headers_lib.Etag.to_field_string etag in
- add ~field:"etag" etag_field_value
- in
- let* () =
- add ~field:"taler-terms-version"
- Assets.Assets_config.terms_legal_version
- in
- let* () =
- add ~field:"avail-languages" Headers.avail_languages_header_value
- in
- let* () =
- let content_type = Fmt.str "%a" Assets.Mimetype.pp mime in
- add ~field:"content-type" content_type
- in
- let* () = add ~field:"content-language" lang in
- respond `OK
-
-let terms req _server _env =
- Logs.info (fun m -> m "GET /terms");
- aux Assets.Terms req _server _env
-
-let privacy req _server _env =
- Logs.info (fun m -> m "GET /privacy");
- aux Assets.Privacy req _server _env
diff --git a/.jjconflict-side-0/src/keys.ml b/.jjconflict-side-0/src/keys.ml
deleted file mode 100644
index 44532ccb..00000000
--- a/.jjconflict-side-0/src/keys.ml
+++ /dev/null
@@ -1,476 +0,0 @@
-module type S = sig
- open Crypto
-
- val sm_pubkey : eddsa_pub
- val sign_with_sm_key : string -> eddsa_sig
- val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
- val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
- val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
-
- val verify_with_signkey :
- pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
-
- val get_signkeys : unit -> Signkey.t list
- val get_denominations : unit -> Denomination.t list
- val get_future_signkeys : unit -> Api.FutureSignKey.t list
- val get_future_denominations : unit -> Api.FutureDenom.t list
- val find_signkey : eddsa_pub -> Signkey.t option
- val find_denomination : denom_hash -> Denomination.t option
- val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
- val find_future_denomination : denom_hash -> Api.FutureDenom.t option
-
- val certify_future_signkey :
- eddsa_pub ->
- master_sig:Signatures.ExchangeSigningKeyValidity.t ->
- (unit, string) result
-
- val certify_future_denomination :
- denom_hash ->
- master_sig:Signatures.DenominationKeyValidity.t ->
- (unit, string) result
-
- val revoke_signkey :
- eddsa_pub ->
- Signatures.MasterSigningKeyRevocation.t ->
- (unit, string) result
-
- val revoke_denomination :
- denom_hash ->
- Signatures.MasterDenominationKeyRevocation.t ->
- (unit, string) result
-
- val save : unit -> (unit, string) result
-end
-
-module Make (Conn : Pg.CONN) = struct
- open Syntax
- open Crypto
- module DenominationHash = Hash.DenominationHash
-
- let read fname = Bos.OS.File.read fname |> unwrap_err_msg
- let write fname s = Bos.OS.File.write fname s |> unwrap_err_msg
- let write_eddsa fname priv = write fname (EddsaPrivateKey.to_octets priv)
- let write_rsa fname priv = write fname (RsaPrivateKey.to_octets priv)
-
- let read_eddsa fname =
- let* data = read fname in
- EddsaPrivateKey.of_octets data
-
- let read_rsa fname =
- let* data = read fname in
- RsaPrivateKey.of_octets data
-
- type sk = Signkey.t
- type future_sk = Api.FutureSignKey.t
- type dn = Denomination.t
- type future_dn = Api.FutureDenom.t
-
- (* TODO ! use lock *)
- (* not sure what to do with coin section_name, rm if possible *)
- type t = {
- sm_key: eddsa_priv;
- sm_pubkey: eddsa_pub;
- sk_ht: (eddsa_pub, sk) Hashtbl.t;
- dn_ht: (denom_hash, dn) Hashtbl.t;
- sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
- dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
- future_sk_ht: (eddsa_pub, future_sk) Hashtbl.t;
- future_dn_ht: (denom_hash, future_dn) Hashtbl.t;
- future_sk_key_ht: (eddsa_pub, eddsa_priv) Hashtbl.t;
- future_dn_key_ht: (denom_hash, rsa_priv) Hashtbl.t;
- dn_section_name_ht: (denom_hash, string) Hashtbl.t;
- }
-
- let conn = (module Conn : Pg.CONN)
- let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key")
- let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i)
-
- let dn_fname section_name =
- Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name)
-
- let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s
-
- let make_future_sk t =
- let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
- let expire =
- Time.Absolute.add start Config.Exchange.signkey_legal_duration
- in
- let stamp_start = Timestamp.of_absolute start in
- let stamp_expire = Timestamp.of_absolute expire in
- let stamp_end = stamp_expire in
- let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
- let signkey_secmod_sig =
- let open Signatures.SigningKeyAnnouncement in
- let exchange_pub = pub in
- let anchor_time = stamp_start in
- let duration = Timestamp.diff stamp_start stamp_expire in
- sign_f ~f:(sign_with_sm_key t) { exchange_pub; anchor_time; duration }
- in
- let future_sk =
- Api.FutureSignKey.
- { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
- in
- Hashtbl.replace t.future_sk_ht pub future_sk;
- Hashtbl.replace t.future_sk_key_ht pub priv;
- ()
-
- let make_future_dn t
- Config.Coin.
- {
- section_name;
- value;
- duration_withdraw;
- duration_spend;
- duration_legal;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- cipher;
- rsa_keysize;
- age_restricted= _;
- } =
- assert (cipher = `RSA);
- let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
- let stamp_start = Timestamp.of_absolute start in
- let stamp_expire_withdraw =
- Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
- in
- let stamp_expire_deposit =
- Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
- in
- let stamp_expire_legal =
- Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
- in
- let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in
- let open Api in
- let rsa_denomination_key =
- RsaDenominationKey.{ age_mask= 0; rsa_pub= pub }
- in
- let denom_pub = DenominationKey.Rsa rsa_denomination_key in
- let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
- let denom_secmod_sig =
- let open Signatures.DenominationKeyAnnouncement in
- let h_denom_pub = h_pub in
- let h_section_name = Hash.Cstring.H64.hash section_name in
- let anchor_time = stamp_start in
- let duration_withdraw =
- Timestamp.diff stamp_start stamp_expire_withdraw
- in
- sign_f ~f:(sign_with_sm_key t)
- { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
- in
- let future_dn =
- 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;
- }
- in
- Hashtbl.replace t.future_dn_ht h_pub future_dn;
- Hashtbl.replace t.future_dn_key_ht h_pub priv;
- ()
-
- let make_new () =
- let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in
- let t =
- {
- sm_key;
- sm_pubkey;
- sk_ht= Hashtbl.create 0xff;
- dn_ht= Hashtbl.create 0xff;
- sk_key_ht= Hashtbl.create 0xff;
- dn_key_ht= Hashtbl.create 0xff;
- future_sk_ht= Hashtbl.create 0xff;
- future_dn_ht= Hashtbl.create 0xff;
- future_sk_key_ht= Hashtbl.create 0xff;
- future_dn_key_ht= Hashtbl.create 0xff;
- dn_section_name_ht= Hashtbl.create 0xff;
- }
- in
- make_future_sk t;
- List.iter (make_future_dn t) Config.Coin.all_coins;
- t
-
- let database_find_sk conn pub =
- let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
- match opt with
- | None -> Fmt.error "Keys: signkey data not found in database"
- | Some sk_data -> Ok sk_data
-
- let database_find_dn conn h_pub =
- let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
- match opt with
- | None -> Fmt.error "Keys: denomination data not found in database"
- | Some dn_data -> Ok dn_data
-
- let list_to_ht l = Hashtbl.of_seq (List.to_seq l)
-
- let load () =
- let* sm_key = read_eddsa sm_key_fname in
- let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
-
- let* sk_keys = list_map read_eddsa (List.init 1 sk_fname) in
- let* sk_l =
- list_map
- (fun priv ->
- let pub = EddsaPrivateKey.pub_of_priv priv in
- let+ sk = database_find_sk conn pub in
- ((pub, sk), (pub, priv)))
- sk_keys
- in
- let sk_ht, sk_key_ht =
- match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
- in
-
- let dn_section_name_ht = Hashtbl.create 0xff in
- let* dn_keys =
- list_map
- (fun coin ->
- let section_name = coin.Config.Coin.section_name in
- let+ priv = read_rsa (dn_fname section_name) in
- (section_name, priv))
- Config.Coin.all_coins
- in
- let* dn_l =
- list_map
- (fun (section_name, priv) ->
- let h_pub =
- priv
- |> RsaPrivateKey.pub_of_priv
- |> RsaPublicKey.to_octets
- |> DenominationHash.hash
- in
- (* fill dn_section_name_ht *)
- Hashtbl.replace dn_section_name_ht h_pub section_name;
- let+ dn = database_find_dn conn h_pub in
- ((h_pub, dn), (h_pub, priv)))
- dn_keys
- in
- let dn_ht, dn_key_ht =
- match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
- in
- (* future keys are not stored anywhere until they are certified with a master_sig
- so we don't have any future key to load *)
- let t =
- {
- sm_key;
- sm_pubkey;
- sk_ht;
- dn_ht;
- sk_key_ht;
- dn_key_ht;
- future_sk_ht= Hashtbl.create 0xff;
- future_dn_ht= Hashtbl.create 0xff;
- future_sk_key_ht= Hashtbl.create 0xff;
- future_dn_key_ht= Hashtbl.create 0xff;
- dn_section_name_ht;
- }
- in
- Ok t
-
- let init () =
- let dir = Config.secmod_dir in
- let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
- if b then Logs.info (fun m -> m "Keys: created directory `%a`" Fpath.pp dir);
- let* l =
- Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
- in
- match List.is_empty l with
- | true ->
- Logs.info (fun m -> m "Keys: empty storage, generating fresh keys");
- let t = make_new () in
- Ok t
- | false ->
- Logs.info (fun m -> m "Keys: loading keys from storage");
- load ()
-
- let t =
- match init () with
- | Error e -> Fmt.failwith "Keys: initialization failure: `%s`." e
- | Ok t ->
- Logs.info (fun m -> m "Keys: initialized");
- t
-
- let sm_pubkey = t.sm_pubkey
- let sign_with_sm_key s = sign_with_sm_key t s
-
- let sign_with_signkey ~pub s =
- match Hashtbl.find_opt t.sk_key_ht pub with
- | None -> Fmt.failwith "Keys sign_with_signkey failure: not found."
- | Some priv -> EddsaSignature.sign ~key:priv s
-
- let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_pubkey s ~msg
-
- let verify_with_master_key =
- EddsaSignature.verify ~key:Config.master_public_key
-
- let verify_with_signkey ~pub s ~msg =
- match Hashtbl.find_opt t.sk_ht pub with
- | None -> Fmt.failwith "Keys verify_with_signkey failure: not found."
- | Some _sk -> EddsaSignature.verify ~key:pub s ~msg
-
- let get_signkeys () = t.sk_ht |> Hashtbl.to_seq_values |> List.of_seq
- let get_denominations () = t.dn_ht |> Hashtbl.to_seq_values |> List.of_seq
-
- let get_future_signkeys () =
- t.future_sk_ht |> Hashtbl.to_seq_values |> List.of_seq
-
- let get_future_denominations () =
- t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq
-
- let find_signkey pub = Hashtbl.find_opt t.sk_ht pub
- let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub
- let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub
- let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_pub
-
- let certify_future_signkey pub ~master_sig =
- match
- ( Hashtbl.find_opt t.future_sk_ht pub,
- Hashtbl.find_opt t.future_sk_key_ht pub )
- with
- | None, _ | _, None ->
- Error "Keys certify_future_signkey: future signkey not found."
- | Some future_sk, Some priv -> (
- match Hashtbl.find_opt t.sk_ht pub with
- | Some _sk -> Error "Keys certify_future_signkey: already certified"
- | None ->
- let Api.FutureSignKey.
- {
- key;
- stamp_start;
- stamp_expire;
- stamp_end;
- signkey_secmod_sig= _;
- } =
- future_sk
- in
- let sk =
- Signkey.
- {
- pub= key;
- stamp_start;
- stamp_expire;
- stamp_end;
- master_sig;
- revoked_sig= None;
- }
- in
- Hashtbl.replace t.sk_ht pub sk;
- Hashtbl.replace t.sk_key_ht pub priv;
- Hashtbl.remove t.future_sk_ht pub;
- Hashtbl.remove t.future_sk_key_ht pub;
-
- let* () = Pg.insert_signkey (module Conn) sk |> unwrap_err_caqti in
- Ok ())
-
- let certify_future_denomination h_pub ~master_sig =
- match
- ( Hashtbl.find_opt t.future_dn_ht h_pub,
- Hashtbl.find_opt t.future_dn_key_ht h_pub )
- with
- | None, _ | _, None ->
- Error "Keys certify_future_denomination: future denomination not found."
- | Some future_dn, Some priv -> (
- match Hashtbl.find_opt t.dn_ht h_pub with
- | Some _dn ->
- Error "Keys certify_future_denomination: already certified"
- | None ->
- let Api.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= _;
- } =
- future_dn
- in
- let rsa_pub =
- match denom_pub with
- | Rsa Api.RsaDenominationKey.{ age_mask= _; rsa_pub } -> rsa_pub
- in
- let dn =
- Denomination.
- {
- pub= rsa_pub;
- value;
- stamp_start;
- stamp_expire_withdraw;
- stamp_expire_deposit;
- stamp_expire_legal;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- age_mask= 0;
- h_pub;
- master_sig;
- revoked_sig= None;
- }
- in
- Hashtbl.replace t.dn_ht h_pub dn;
- Hashtbl.replace t.dn_key_ht h_pub priv;
- Hashtbl.replace t.dn_section_name_ht h_pub section_name;
- Hashtbl.remove t.future_dn_ht h_pub;
- Hashtbl.remove t.future_dn_key_ht h_pub;
-
- let* () = Pg.insert_denom (module Conn) dn |> unwrap_err_caqti in
- Ok ())
-
- let revoke_signkey pub revoked_sig =
- match Hashtbl.find_opt t.sk_ht pub with
- | None -> Error "Keys revoke_signkey: signkey not found."
- | Some sk ->
- let sk = { sk with revoked_sig= Some revoked_sig } in
- Hashtbl.replace t.sk_ht pub sk;
-
- (* TODO revoke, apply to database *)
- Ok ()
-
- let revoke_denomination pub revoked_sig =
- match Hashtbl.find_opt t.dn_ht pub with
- | None -> Error "Keys revoke_denomination: denomination not found."
- | Some dn ->
- let dn = { dn with revoked_sig= Some revoked_sig } in
- Hashtbl.replace t.dn_ht pub dn;
-
- (* TODO revoke, apply to database *)
- Ok ()
-
- let save () =
- let* () = write_eddsa sm_key_fname t.sm_key in
- let* () =
- Hashtbl.to_seq_values t.sk_key_ht
- |> List.of_seq
- |> List.mapi (fun i priv -> write_eddsa (sk_fname i) priv)
- |> list_iter Fun.id
- in
- let* () =
- Hashtbl.to_seq t.dn_key_ht
- |> List.of_seq
- |> list_iter (fun (h_pub, priv) ->
- match Hashtbl.find_opt t.dn_section_name_ht h_pub with
- | None -> Error "Keys save: invalid state, section_name not found"
- | Some section_name -> write_rsa (dn_fname section_name) priv)
- in
- Logs.info (fun m -> m "saved private keys data");
- Ok ()
-end
diff --git a/.jjconflict-side-0/src/keys.mli b/.jjconflict-side-0/src/keys.mli
deleted file mode 100644
index cedff889..00000000
--- a/.jjconflict-side-0/src/keys.mli
+++ /dev/null
@@ -1,45 +0,0 @@
-module type S = sig
- open Crypto
-
- val sm_pubkey : eddsa_pub
- val sign_with_sm_key : string -> eddsa_sig
- val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
- val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
- val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
-
- val verify_with_signkey :
- pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
-
- val get_signkeys : unit -> Signkey.t list
- val get_denominations : unit -> Denomination.t list
- val get_future_signkeys : unit -> Api.FutureSignKey.t list
- val get_future_denominations : unit -> Api.FutureDenom.t list
- val find_signkey : eddsa_pub -> Signkey.t option
- val find_denomination : denom_hash -> Denomination.t option
- val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
- val find_future_denomination : denom_hash -> Api.FutureDenom.t option
-
- val certify_future_signkey :
- eddsa_pub ->
- master_sig:Signatures.ExchangeSigningKeyValidity.t ->
- (unit, string) result
-
- val certify_future_denomination :
- denom_hash ->
- master_sig:Signatures.DenominationKeyValidity.t ->
- (unit, string) result
-
- val revoke_signkey :
- eddsa_pub ->
- Signatures.MasterSigningKeyRevocation.t ->
- (unit, string) result
-
- val revoke_denomination :
- denom_hash ->
- Signatures.MasterDenominationKeyRevocation.t ->
- (unit, string) result
-
- val save : unit -> (unit, string) result
-end
-
-module Make (_ : Pg.CONN) : S
diff --git a/.jjconflict-side-0/src/mte.ml b/.jjconflict-side-0/src/mte.ml
deleted file mode 100644
index 77f07de8..00000000
--- a/.jjconflict-side-0/src/mte.ml
+++ /dev/null
@@ -1,83 +0,0 @@
-(* MTE - the MirageOS Taler Exchange
- Copyright (C) 2025 Olivier Pierre
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU Affero General Public License as published by
- the Free Software Foundation, version 3.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Affero General Public License for more details.
-
- You should have received a copy of the GNU Affero General Public License
- along with this program. If not, see . *)
-
-let hello req _server _env =
- let open Vif.Response in
- let open Syntax in
- let* () = with_string req "Hello~~\n" in
- let* () = add ~field:"content-type" "text/plain" in
- respond `OK
-
-let routes =
- let open Vif.Uri in
- let open Vif.Route in
- let get path = get (path /?? any) in
- let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in
- let v s = rel / s in
- let tos =
- [
- get rel --> hello;
- get (v "terms") --> Http_terms.terms;
- get (v "privacy") --> Http_terms.privacy;
- ]
- in
- let status_info =
- [
- get (v "seed") --> Http_information.seed;
- get (v "config") --> Http_information.config;
- get (v "keys") --> Http_information.keys;
- ]
- in
- let management =
- let open Http_management in
- let v s = v "management" / s in
- [
- get (v "keys") --> Keys_get.f;
- post (v "keys") Keys_post.jsont --> Keys_post.f;
- post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
- --> Denom_revoke.f;
- post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont
- --> Signkey_revoke.f;
- post (v "auditors") Auditors.jsont --> Auditors.f;
- post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont
- --> Auditors_disable.f;
- post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f;
- post (v "global-fees") Global_fees.jsont --> Global_fees.f;
- post (v "wire") Wire.jsont --> Wire.f;
- post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f;
- post (v "drain") Drain.jsont --> Drain.f;
- post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f;
- post (v "partners") Partners.jsont --> Partners.f;
- ]
- in
- tos @ status_info @ management
-
-let () =
- Util.Log_reporter.setup ();
- let cfg =
- let port = Config.Exchange.port in
- let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
- Vif.config ~reporter:Util.Log_reporter.reporter sockaddr
- in
- Miou_unix.run @@ fun () ->
- Caqti_miou.Switch.run @@ fun caqti_switch ->
- let env : Devices.env =
- { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
- in
- let devices = Vif.Devices.[ Devices.db_connection; Devices.keys ] in
- let middlewares = Vif.Middlewares.[] in
- Logs.info (fun m ->
- m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
- Vif.run ~cfg ~devices ~middlewares routes env
diff --git a/.jjconflict-side-0/src/parse_config.ml b/.jjconflict-side-0/src/parse_config.ml
deleted file mode 100644
index 86254830..00000000
--- a/.jjconflict-side-0/src/parse_config.ml
+++ /dev/null
@@ -1,232 +0,0 @@
-(* rudimentary configuration file parser (INI-like)
- https://docs.taler.net/manpages/taler-exchange.conf.5.html
-
- do not support "$"-path expansion *)
-
-open Angstrom
-
-type item = {
- key: string;
- value: string;
-}
-
-type section = {
- header: string;
- items: item list;
-}
-
-let fail fmt =
- let k _ppf = exit 1 in
- Fmt.kpf k Fmt.stderr ("Configuration failure: " ^^ fmt ^^ ".@.")
-
-let is_eol = function '\n' | '\r' -> true | _ -> false
-let is_whitespace = function ' ' | '\t' -> true | _ -> false
-let blanks = skip_while is_whitespace
-
-module Config_section = struct
- type t =
- | Blank
- | Comment of string
- | Header of string
- | Item of item
-
- let id =
- let ident_char = function
- | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
- | _ -> false
- in
- take_while1 ident_char >>| String.lowercase_ascii
-
- let line = take_till is_eol <* end_of_line
- let blank_line = blanks <* end_of_line >>| fun () -> Blank
- let comment = blanks *> (char '#' <|> char '%') *> line >>| fun s -> Comment s
-
- let header =
- blanks *> char '[' *> id <* char ']' <* blanks <* end_of_line >>| fun s ->
- Header s
-
- let item_value =
- let unquoted_value =
- take_while1 (fun c -> not (is_whitespace c || is_eol c))
- <* blanks
- <* end_of_line
- in
- let quoted_value =
- char '"' *> take_till is_eol <* end_of_line >>= fun s ->
- match String.ends_with ~suffix:"\"" s && s <> "\"" with
- | false -> fail "invalid quoted value"
- | true ->
- let value = String.sub s 0 (String.length s - 1) in
- return value
- in
- quoted_value <|> unquoted_value
-
- let item =
- lift2
- (fun key value -> Item { key; value })
- id
- (blanks *> char '=' *> blanks *> item_value)
-
- let config =
- many (choice [ blank_line; comment; header; item ]) <* end_of_input
-
- let fold_sections l =
- let rec loop section_l item_l l =
- match l with
- | [] ->
- if List.is_empty item_l then section_l
- else fail "invalid configuration structure"
- | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
- | Item item :: tl -> loop section_l (item :: item_l) tl
- | Header header :: tl ->
- let section = { header; items= item_l } in
- loop (section :: section_l) [] tl
- in
- loop [] [] (List.rev l)
-
- let parse s =
- match parse_string ~consume:All config s with
- | Error msg -> fail "parse error `%s`" msg
- | Ok v -> fold_sections v
-end
-
-module Config_duration = struct
- type duration_element = {
- number: int;
- dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
- }
-
- let integer =
- take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
- match int_of_string_opt s with
- | None -> fail "expected integer, got `%s`" s
- | Some i -> return i
-
- let duration_element =
- let number = blanks *> integer in
- let dunit =
- blanks *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
- >>= function
- | "year" | "years" -> return `Year
- | "week" | "weeks" -> return `Week
- | "day" | "days" -> return `Day
- | "hour" | "hours" -> return `Hour
- | "minute" | "minutes" -> return `Minute
- | "second" | "seconds" | "s" -> return `Second
- | s -> fail "expected a duration unit, got `%s`" s
- in
- lift2 (fun number dunit -> { number; dunit }) number dunit
-
- let duration = many1 duration_element <* end_of_input
-
- (* TODO put this in Time.Relative *)
- let dunit_to_seconds u =
- let rec f = function
- | `Year -> 365 * f `Day
- | `Week -> 7 * f `Day
- | `Day -> 24 * f `Hour
- | `Hour -> 60 * f `Minute
- | `Minute -> 60 * f `Second
- | `Second -> 1
- in
- f u
-
- let to_time_span t =
- List.fold_left
- (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
- 0 t
- |> Int64.of_int
- |> Time.Relative.of_s
-
- let parse s : duration_element list =
- match parse_string ~consume:All duration s with
- | Error msg -> fail "duration parse error `%s`" msg
- | Ok v -> v
-end
-
-let unwrap = function Error e -> fail "`%s`." e | Ok v -> v
-
-let get_opt t ~section ~field =
- match List.find_opt (fun v -> v.header = section) t with
- | None -> None
- | Some v -> (
- match List.find_opt (fun item -> item.key = field) v.items with
- | None -> None
- | Some item -> Some item.value)
-
-let get t ~section ~field =
- match get_opt t ~section ~field with
- | None -> fail "option `[%s].%s` not found" section field
- | Some v -> v
-
-let int s =
- match int_of_string_opt s with
- | None -> fail "expected int value, got `%s`" s
- | Some v -> v
-
-let float s =
- match float_of_string_opt s with
- | None -> fail "expected float value, got `%s`" s
- | Some v -> v
-
-let const_value a b =
- match a = b with false -> fail "unexpected value `%s`" b | true -> a
-
-let yes_no = function
- | "NO" -> `NO
- | "YES" -> `YES
- | s -> fail "expected `YES`/`NO` value, got `%s`" s
-
-let uri s = Uri.of_string s
-let amount s = s |> Amount.of_string |> unwrap
-let duration s = Config_duration.(s |> parse |> to_time_span)
-
-let ed25519 s =
- s
- |> B32.decode
- |> unwrap
- |> Mirage_crypto_ec.Ed25519.pub_of_octets
- |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
- |> unwrap
-
-let etag s =
- match Headers_lib.Etag.parse s with
- | Ok etag -> etag
- | Error e -> (
- (* retry with quotes if needed *)
- match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with
- | Ok etag -> etag
- | Error _ -> fail "could not parse etag `%s`: %s" s e)
-
-(* TODO
- move to another module
- can we type the json as a Int_map directly? *)
-module Alt_unit_names = struct
- open Syntax
- module String_map = Map.Make (String)
-
- let string_map_jsont = Jsont.Object.as_string_map Jsont.string
-
- let decode s =
- let* string_map = Jsont_bytesrw.decode_string string_map_jsont s in
- let l = String_map.to_list string_map in
- let* l =
- list_map
- (fun (k, v) ->
- match int_of_string_opt k with
- | None -> Error "alt_unit_names has a non-integer key"
- | Some k -> Ok (k, v))
- l
- in
- match List.find_opt (fun (i, _) -> i = 0) l with
- | None -> Error "alt_unit_names with no entry for base value \"0\""
- | Some _ -> Ok l
-
- let encode l =
- let l = List.map (fun (k, v) -> (string_of_int k, v)) l in
- let string_map = String_map.of_list l in
- let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in
- s
-
- let encode_exn l = encode l |> Result.get_ok
-end
diff --git a/.jjconflict-side-0/src/pg.ml b/.jjconflict-side-0/src/pg.ml
deleted file mode 100644
index fa9abe10..00000000
--- a/.jjconflict-side-0/src/pg.ml
+++ /dev/null
@@ -1,364 +0,0 @@
-(* TODO
- check signed/unsigned ints
- check endianness
- can we avoid amount tuple boilerplate?
- clean up caqti error type
-
- transaction
-
- GNU Taler use of db-events?
- it seems caqti/pgx does not support it *)
-
-module type CONN = Caqti_miou.CONNECTION
-
-module Caqti_type = struct
- include Caqti_type
- include Pg_type
- include Caqti_request.Infix
-end
-
-open Crypto
-open Api
-
-let preflight =
- let l =
- List.map
- Caqti_type.(unit ->. unit)
- [
- "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL \
- SERIALIZABLE;";
- "SET enable_sort=OFF;";
- "SET enable_seqscan=OFF;";
- "SET enable_mergejoin=OFF;";
- "SET search_path TO exchange;";
- ]
- in
- fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l
-
-let find_signkey =
- let find_signkey =
- Caqti_type.(eddsa_pub ->? signkey_data)
- "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
- esk.expire_legal, esk.master_sig, skr.master_sig FROM \
- exchange_sign_keys AS esk LEFT JOIN signkey_revocations AS skr ON \
- esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1"
- in
- fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
- Conn.find_opt find_signkey exchange_pub
-
-let get_active_signkeys =
- let get_active_signkeys =
- Caqti_type.(time ->* signkey_data)
- "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
- esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \
- WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \
- signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)"
- in
- fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now
-
-(* note: does not update revocation *)
-let insert_signkey =
- let insert_signkey =
- Caqti_type.(signkey_data ->. unit)
- "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
- expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_signkey v
-
-let find_denom =
- let find_denom =
- Caqti_type.(denom_hash ->? denom_data)
- "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
- dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
- (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
- dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
- dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
- = dnr.denominations_serial WHERE dn.denom_pub_hash=$1"
- in
- fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub
-
-let get_denominations =
- let get_denominations =
- Caqti_type.(unit ->* denom_data)
- "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
- dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
- (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
- dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
- dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
- = dnr.denominations_serial"
- in
- fun (module Conn : CONN) -> Conn.collect_list get_denominations ()
-
-(* note: does not update revocation *)
-let insert_denom =
- let insert_denom =
- Caqti_type.(denom_data ->. unit)
- "INSERT INTO denominations (denom_pub, coin, valid_from, \
- expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \
- fee_deposit, fee_refresh, fee_refund, age_mask, denom_pub_hash, \
- master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \
- ($12,$13), ($14,$15), $16, $17, $18)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_denom v
-
-let insert_denomination_revocation =
- let denomination_revocation_insert =
- let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in
- Caqti_type.(t2 denom_hash master_sig ->. unit)
- "INSERT INTO denomination_revocations (denominations_serial, master_sig) \
- SELECT denominations_serial, $2 FROM denominations WHERE \
- denom_pub_hash=$1"
- in
- fun (module Conn : CONN) h_denom_pub master_sig ->
- Conn.exec denomination_revocation_insert (h_denom_pub, master_sig)
-
-let insert_signkey_revocation =
- let signkey_revocation_insert =
- let master_sig = Signatures.MasterSigningKeyRevocation.caqti in
- Caqti_type.(t2 eddsa_pub master_sig ->. unit)
- "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \
- esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1"
- in
- fun (module Conn : CONN) exchange_pub master_sig ->
- Conn.exec signkey_revocation_insert (exchange_pub, master_sig)
-
-let get_auditor_timestamp =
- let get_auditor_timestamp =
- Caqti_type.(eddsa_pub ->? time)
- "SELECT last_change FROM auditors WHERE auditor_pub=$1"
- in
- fun (module Conn : CONN) auditor_pub ->
- Conn.find_opt get_auditor_timestamp auditor_pub
-
-let insert_auditor =
- let insert_auditor =
- Caqti_type.(t4 eddsa_pub string string time ->. unit)
- "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
- is_active, last_change) VALUES ($1, $2, $3, true, $4)"
- in
- fun (module Conn : CONN)
- AuditorSetupMessage.
- { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
- ->
- Conn.exec insert_auditor
- (auditor_pub, auditor_name, auditor_url, validity_start)
-
-let update_auditor =
- let update_auditor =
- Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
- "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
- last_change=$5 WHERE auditor_pub=$1"
- in
- fun (module Conn : CONN)
- AuditorSetupMessage.
- { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
- ->
- Conn.exec update_auditor
- (auditor_pub, auditor_url, auditor_name, true, validity_start)
-
-let disable_auditor =
- let update_auditor =
- Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
- "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
- last_change=$5 WHERE auditor_pub=$1"
- in
- fun (module Conn : CONN) ~auditor_pub ~change_date ->
- Conn.exec update_auditor (auditor_pub, "", "", false, change_date)
-
-let insert_auditor_denom_sig =
- let insert_auditor_denom_sig =
- let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
- Caqti_type.(t3 eddsa_pub denom_hash auditor_sig ->. unit)
- "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \
- INSERT INTO auditor_denom_sigs (auditor_uuid, denominations_serial, \
- auditor_sig) SELECT ax.auditor_uuid, denominations_serial, $3 FROM \
- denominations CROSS JOIN ax WHERE denom_pub_hash=$2 ON CONFLICT DO \
- NOTHING"
- in
- fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig ->
- Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig)
-
-(* todo auditors
- maybe check that url and name are unique/same for each auditor_pub
- and do the ht logic out of pg.ml? *)
-(* this does not return auditors that are not auditing any denom *)
-let get_auditor_keys =
- let get_auditor_keys =
- let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
- Caqti_type.(unit ->* t5 eddsa_pub string string denom_hash auditor_sig)
- "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \
- ads.auditor_sig FROM auditor_denom_sigs AS ads JOIN auditors AS a USING \
- (auditor_uuid) JOIN denominations AS dn USING (denominations_serial) \
- WHERE a.is_active"
- in
- fun (module Conn : CONN) ->
- let open Syntax in
- let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in
- let ht = Hashtbl.create 0xff in
- List.iter
- (fun (pub, url, name, denom_pub_h, auditor_sig) ->
- let k = (pub, url, name) in
- match Hashtbl.find_opt ht k with
- | None -> Hashtbl.replace ht k [ (denom_pub_h, auditor_sig) ]
- | Some l -> Hashtbl.replace ht k ((denom_pub_h, auditor_sig) :: l))
- l;
- let l = Hashtbl.to_seq ht |> List.of_seq in
- let l =
- List.map
- (fun ((auditor_pub, auditor_url, auditor_name), auditor_denoms) ->
- let denomination_keys =
- List.map
- (fun (denom_pub_h, auditor_sig) ->
- AuditorDenominationKey.{ denom_pub_h; auditor_sig })
- auditor_denoms
- in
- AuditorKeys.
- { auditor_pub; auditor_url; auditor_name; denomination_keys })
- l
- in
- Ok l
-
-let insert_wire_fee =
- let insert_wire_fee =
- let master_sig = Signatures.MasterWireFee.caqti in
- Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit)
- "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \
- closing_fee, master_sig) VALUES ($1, $2, $3, ($4,$5), ($6,$7), $8)"
- in
- fun (module Conn : CONN)
- WireFeeSetupMessage.
- {
- wire_method;
- master_sig_wire;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- }
- ->
- Conn.exec insert_wire_fee
- (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire)
-
-let get_wire_fees_by_time =
- let get_wire_fee_by_time =
- Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee)
- "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
- FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \
- $3"
- in
- fun (module Conn : CONN) ~wire_method ~start_date ~end_date ->
- Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date)
-
-let get_wire_fees =
- let get_wire_fees =
- Caqti_type.(string ->* aggregate_transfer_fee)
- "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
- FROM wire_fee WHERE wire_method=$1"
- in
- fun (module Conn : CONN) ~wire_method ->
- Conn.collect_list get_wire_fees wire_method
-
-let get_global_fees =
- let get_global_fees =
- Caqti_type.(time ->* global_fee)
- "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
- (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
- master_sig FROM global_fee WHERE start_date >= $1"
- in
- fun (module Conn : CONN) ~start_date ->
- Conn.collect_list get_global_fees start_date
-
-let get_global_fees_by_time =
- let get_global_fees_by_time =
- Caqti_type.(t2 time time ->* global_fee)
- "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
- (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
- master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2"
- in
- fun (module Conn : CONN) ~start_date ~end_date ->
- Conn.collect_list get_global_fees_by_time (start_date, end_date)
-
-let insert_global_fees =
- let insert_global_fees =
- Caqti_type.(global_fee ->. unit)
- "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
- purse_fee, history_expiration, purse_account_limit, purse_timeout, \
- master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
- $12)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_global_fees v
-
-let get_wire_timestamp =
- let get_wire_timestamp =
- Caqti_type.(payto_uri ->? time)
- "SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
- in
- fun (module Conn : CONN) ~payto_uri ->
- Conn.find_opt get_wire_timestamp payto_uri
-
-let insert_wire =
- let insert_wire =
- Caqti_type.(t3 exchange_wire_account bool time ->. unit)
- "INSERT INTO wire_accounts (payto_uri, conversion_url, \
- credit_restrictions, debit_restrictions, master_sig, bank_label, \
- priority, is_active, last_change) VALUES \
- ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)"
- in
- fun (module Conn : CONN) ~last_change v ->
- let is_active = true in
- Conn.exec insert_wire (v, is_active, last_change)
-
-let update_wire =
- let update_wire =
- Caqti_type.(t3 exchange_wire_account bool time ->. unit)
- "UPDATE wire_accounts SET conversion_url=$2, \
- debit_restrictions=$3::TEXT::JSONB, \
- credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
- priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
- in
- fun (module Conn : CONN) ~is_active ~last_change v ->
- Conn.exec update_wire (v, is_active, last_change)
-
-let disable_wire =
- let disable_wire =
- Caqti_type.(t2 payto_uri time ->. unit)
- "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \
- credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \
- priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1"
- in
- fun (module Conn : CONN) ~payto_uri ~validity_end ->
- Conn.exec disable_wire (payto_uri, validity_end)
-
-let get_wire_accounts =
- let get_wire_accounts =
- Caqti_type.(unit ->* exchange_wire_account)
- "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
- credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
- wire_accounts WHERE is_active"
- in
- fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts ()
-
-let insert_drain_profit =
- let insert_drain_profit =
- Caqti_type.(drain_profit_message ->. unit)
- "INSERT INTO profit_drains (wtid, account_section, payto_uri, \
- trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v
-
-let insert_aml_officer =
- let exchange_do_insert_aml_officer =
- Caqti_type.(aml_officer_setup ->! time)
- "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \
- $4, $5, $6)"
- in
- fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v
-
-let insert_partner =
- let insert_partner =
- Caqti_type.(exchange_partner_setup ->. unit)
- "INSERT INTO partners (partner_master_pub, start_date, end_date, \
- wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \
- $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_partner v
diff --git a/.jjconflict-side-0/src/pg_type.ml b/.jjconflict-side-0/src/pg_type.ml
deleted file mode 100644
index 40fb5826..00000000
--- a/.jjconflict-side-0/src/pg_type.ml
+++ /dev/null
@@ -1,360 +0,0 @@
-(* this module defines caqti encoding/decodings *)
-open Caqti_type
-open Crypto
-open Api
-
-let amount : Amount.t t =
- let open Amount in
- custom
- ~encode:(fun amount -> Ok (amount.value, amount.fraction))
- ~decode:(fun (value, fraction) ->
- Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
- (t2 int64 int32)
-
-(* we want to use int64 timestamps,
- not postgresql built-in timestamp type *)
-let ptime : unit t = Caqti_type.unit
-let time = Timestamp.caqti
-let time_span = Time.Relative.caqti
-let age_mask : int t = Caqti_type.int
-let rsa_pub = RsaPublicKey.caqti
-let eddsa_pub = EddsaPublicKey.caqti
-let eddsa_sig = EddsaSignature.caqti
-
-(* todo: enum type for wire_method? *)
-let wire_method = Caqti_type.string
-let payto_uri = Caqti_type.string
-let b32 = B32.caqti
-
-include struct
- (* alias for hash *)
- open Hash
-
- let fullpayto_hash = FullPaytoHash.caqti
- let nomalizaedpayto_hash = NormalizedPaytoHash.caqti
- let denom_hash = DenominationHash.caqti
- let privatecontract_hash = PrivateContractHash.caqti
- let extensionspolicy_hash = ExtensionsPolicyHash.caqti
- let merchantwire_hash = MerchantWireHash.caqti
- let agecommitment_hash = AgeCommitmentHash.caqti
- let blindedcoin_hash = BlindedCoinHash.caqti
- let coinpub_hash = CoinPubHash.caqti
- let outputcommitment_hash = OutputCommitmentHash.caqti
- let planchets_hash = HashPlanchetsP.caqti
-end
-
-let signkey_data =
- let master_sig = Signatures.ExchangeSigningKeyValidity.caqti in
- let revoked_sig = option Signatures.MasterSigningKeyRevocation.caqti in
- custom
- ~encode:(fun
- Signkey.
- { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
- ->
- Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig))
- ~decode:(fun
- (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig) ->
- Ok { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig })
- (t6 eddsa_pub time time time master_sig revoked_sig)
-
-let denom_data =
- let master_sig = Signatures.DenominationKeyValidity.caqti in
- let revoked_sig = option Signatures.MasterDenominationKeyRevocation.caqti in
- custom
- ~encode:(fun
- Denomination.
- {
- 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;
- }
- ->
- Ok
- ( 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) ))
- ~decode:(fun
- ( 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) )
- ->
- Ok
- {
- 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;
- })
- (t12 rsa_pub amount time time time time amount amount amount amount int
- (t3 denom_hash master_sig revoked_sig))
-
-let account_restrictions =
- custom
- ~encode:(fun l -> Api.encode (Jsont.list AccountRestriction.jsont) l)
- ~decode:(fun s -> Api.decode (Jsont.list AccountRestriction.jsont) s)
- string
-
-let global_fee =
- let master_sig = Signatures.GlobalFees.caqti in
- custom
- ~encode:(fun
- GlobalFees.
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- }
- ->
- Ok
- ( start_date,
- end_date,
- history_fee,
- account_fee,
- purse_fee,
- history_expiration,
- purse_account_limit,
- purse_timeout,
- master_sig ))
- ~decode:(fun
- ( start_date,
- end_date,
- history_fee,
- account_fee,
- purse_fee,
- history_expiration,
- purse_account_limit,
- purse_timeout,
- master_sig )
- ->
- Ok
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- })
- Caqti_type.(
- t9 time time amount amount amount time_span int32 time_span master_sig)
-
-let aggregate_transfer_fee =
- let master_sig = Signatures.MasterWireFee.caqti in
- Caqti_type.custom
- ~encode:(fun
- AggregateTransferFee.
- { wire_fee; closing_fee; start_date; end_date; sig_ }
- -> Ok (wire_fee, closing_fee, start_date, end_date, sig_))
- ~decode:(fun (wire_fee, closing_fee, start_date, end_date, sig_) ->
- Ok
- AggregateTransferFee.
- { wire_fee; closing_fee; start_date; end_date; sig_ })
- Caqti_type.(t5 amount amount time time master_sig)
-
-let exchange_wire_account =
- let master_sig = Signatures.MasterWireDetails.caqti in
- Caqti_type.custom
- ~encode:(fun
- ExchangeWireAccount.
- {
- payto_uri;
- conversion_url;
- debit_restrictions;
- credit_restrictions;
- master_sig;
- bank_label;
- priority;
- }
- ->
- Ok
- ( payto_uri,
- conversion_url,
- debit_restrictions,
- credit_restrictions,
- master_sig,
- bank_label,
- priority ))
- ~decode:(fun
- ( payto_uri,
- conversion_url,
- debit_restrictions,
- credit_restrictions,
- master_sig,
- bank_label,
- priority )
- ->
- Ok
- {
- payto_uri;
- conversion_url;
- debit_restrictions;
- credit_restrictions;
- master_sig;
- bank_label;
- priority;
- })
- Caqti_type.(
- t7 payto_uri (option string) account_restrictions account_restrictions
- master_sig (option string) (option int))
-
-let drain_profit_message =
- let master_sig = Signatures.MasterDrainProfit.caqti in
- Caqti_type.custom
- ~encode:(fun
- DrainProfitsMessage.
- {
- wtid;
- debit_account_section;
- credit_payto_uri;
- date;
- amount;
- master_sig;
- }
- ->
- Ok
- (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig))
- ~decode:(fun
- (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig)
- ->
- Ok
- {
- wtid;
- debit_account_section;
- credit_payto_uri;
- date;
- amount;
- master_sig;
- })
- Caqti_type.(t6 b32 string string time amount master_sig)
-
-let aml_officer_setup =
- let master_sig = Signatures.MasterAmlOfficerStatus.caqti in
- Caqti_type.custom
- ~encode:(fun
- AmlOfficerSetup.
- {
- officer_pub;
- master_sig;
- officer_name;
- is_active;
- read_only;
- change_date;
- }
- ->
- Ok
- ( officer_pub,
- master_sig,
- officer_name,
- is_active,
- read_only,
- change_date ))
- ~decode:(fun
- ( officer_pub,
- master_sig,
- officer_name,
- is_active,
- read_only,
- change_date )
- ->
- Ok
- {
- officer_pub;
- master_sig;
- officer_name;
- is_active;
- read_only;
- change_date;
- })
- Caqti_type.(t6 eddsa_pub master_sig string bool bool time)
-
-let exchange_partner_setup =
- let master_sig = Signatures.PartnerConfiguration.caqti in
- Caqti_type.custom
- ~encode:(fun
- ExchangePartnerSetupRequest.
- {
- partner_pub;
- start_date;
- end_date;
- wad_frequency;
- wad_fee;
- master_sig;
- partner_base_url;
- }
- ->
- Ok
- ( partner_pub,
- start_date,
- end_date,
- wad_frequency,
- wad_fee,
- master_sig,
- partner_base_url ))
- ~decode:(fun
- ( partner_pub,
- start_date,
- end_date,
- wad_frequency,
- wad_fee,
- master_sig,
- partner_base_url )
- ->
- Ok
- {
- partner_base_url;
- partner_pub;
- wad_frequency;
- master_sig;
- start_date;
- end_date;
- wad_fee;
- })
- Caqti_type.(t7 eddsa_pub time time time_span amount master_sig string)
diff --git a/.jjconflict-side-0/src/respond.ml b/.jjconflict-side-0/src/respond.ml
deleted file mode 100644
index ea17f7f7..00000000
--- a/.jjconflict-side-0/src/respond.ml
+++ /dev/null
@@ -1,39 +0,0 @@
-(* TODO response
- use ErrorDetail *)
-
-let respond_json req content status =
- let open Vif.Response in
- let open Syntax in
- let* () = add ~field:"content-type" "application/json" in
- let* () = with_string req content in
- respond status
-
-let mk_error_content ?hint _status =
- let open Api in
- let code = -1 in
- let err = ErrorDetail.make ?hint code in
- encode_exn ErrorDetail.jsont err
-
-let error ~hint req =
- Logs.err (fun m -> m "internal server error: %s" hint);
- let body = mk_error_content ~hint `Internal_server_error in
- respond_json req body `Internal_server_error
-
-let bad_request ?hint req =
- Logs.err (fun m -> m "bad request");
- let body = mk_error_content ?hint `Bad_request in
- respond_json req body `Bad_request
-
-let ok content req =
- Logs.debug (fun m -> m "ok");
- respond_json req content `OK
-
-let not_modified () =
- Logs.debug (fun m -> m "not modified");
- let open Vif.Response in
- let open Syntax in
- let* () = empty in
- respond `Not_modified
-
-let result res req =
- match res with Error hint -> error ~hint req | Ok content -> ok content req
diff --git a/.jjconflict-side-0/src/signatures.ml b/.jjconflict-side-0/src/signatures.ml
deleted file mode 100644
index 1d57405e..00000000
--- a/.jjconflict-side-0/src/signatures.ml
+++ /dev/null
@@ -1,1310 +0,0 @@
-(* TODO signatures
- check with taler-wallet
- check signed/unsigned ints
- check endianness *)
-open Hash
-
-module Aliases = struct
- module Timestamp = struct
- type t = Time.Timestamp.t
-
- let bin = Time.Timestamp.bin
- end
-
- module TimestampNBO = struct
- type t = Time.Timestamp.t
-
- let bin = Time.Timestamp.bin_nbo
- end
-
- module TimeRelative = struct
- type t = Time.Relative.t
-
- let bin = Time.Relative.bin
- end
-
- module TimeRelativeNBO = struct
- type t = Time.Relative.t
-
- let bin = Time.Relative.bin_nbo
- end
-
- module AmountNBO = struct
- type t = Amount.t
-
- let bin = Amount.bin_nbo
- end
-
- (* - Keys - *)
-
- (* some of those are actuall ecdhe, or union of eddsa|ecdhe *)
- open Crypto
- module PursePublicKey = EddsaPublicKey
- module AuditorPublicKeyP = EddsaPublicKey
- module ReservePublicKeyP = EddsaPublicKey
- module MerchantPublicKeyP = EddsaPublicKey
- module TransferPublicKeyP = EddsaPublicKey
- module AmlOfficerPublicKeyP = EddsaPublicKey
- module ExchangePublicKeyP = EddsaPublicKey
- module MasterPublicKeyP = EddsaPublicKey
- module CoinSpendPublicKeyP = EddsaPublicKey
- module TokenPublicKeyP = EddsaPublicKey
- module ReservePrivateKeyP = EddsaPrivateKey
- module MerchantPrivateKeyP = EddsaPrivateKey
- module TransferPrivateKeyP = EddsaPrivateKey
- module AmlOfficerPrivateKeyP = EddsaPrivateKey
- module ExchangePrivateKeyP = EddsaPrivateKey
- module MasterPrivateKeyP = EddsaPrivateKey
- module CoinSpendPrivateKeyP = EddsaPrivateKey
- module MasterSignatureP = EddsaSignature
- module ReserveSignatureP = EddsaSignature
- module ExchangeSignatureP = EddsaSignature
- module CoinSpendSignatureP = EddsaSignature
-end
-
-open Aliases
-
-let int32_size = 4
-let int64_size = 8
-
-module Bytes32 = struct
- type t = string
-
- let bin = Bin.bytes 32
-end
-
-module Bytes64 = struct
- type t = string
-
- let bin = Bin.bytes 64
-end
-
-module TransferSecretP = Bytes64
-module LinkSecretP = Bytes64
-module EncryptedLinkSecretP = Bytes64
-module BlindingMasterSeed = Bytes32
-module BlindingMasterSecret = Bytes32
-module WireTransferIdentifierRawP = Bytes32
-module PublicRefreshCoinNonceP = Bytes64
-module DenominationBlindingKeyP = Bytes32
-module RefreshCommitmentP = Bytes64
-
-module UUID = struct
- type t = string
-
- let size = 4 * int32_size
- let bin = Bin.bytes size
-end
-
-module WadId = struct
- type t = string
-
- let size = 6 * int32_size
- let bin = Bin.bytes size
-end
-
-module AgeMask = struct
- type t = int32
-
- let bin = Bin.beint32
-end
-
-(* --- *)
-
-(* EccSignaturePurpose *)
-module Purpose = struct
- type t = {
- size: int32;
- purpose: int32;
- }
-
- let bin =
- let open Bin in
- record (fun size purpose -> { size; purpose })
- |+ field beint32 (fun t -> t.size)
- |+ field beint32 (fun t -> t.purpose)
- |> sealr
-
- let make ~size purpose = { size= Int32.of_int size; purpose }
- let dummy = make ~size:0 0_l
-
- (* helper function to make ['signature Bin.t]
- to compute [t.size], we first build a bin with a dummy purpose *)
- let make_bin =
- let get_size f =
- let open Bin in
- match Size.of_value (Size.size_of (f dummy)) with
- | Dynamic _ | Unknown ->
- Fmt.failwith "size_of failure: size is not Static"
- | Static n -> n
- in
- fun code f -> make ~size:(get_size f) code |> f
-
- let field purpose = Bin.field bin (fun _t -> purpose)
-end
-
-(* --- Packed Signatures --- *)
-
-module MK (R : sig
- type r
-
- val bin : r Bin.t
-end) : sig
- open Crypto
-
- type r = R.r
- type t
-
- val sign_f : f:(string -> eddsa_sig) -> r -> t
-
- val verify_f :
- f:(eddsa_sig -> msg:string -> (unit, string) result) ->
- t ->
- r ->
- (unit, string) result
-
- val jsont : t Jsont.t
- val caqti : t Caqti_type.t
-
- (* TODO rm *)
- (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *)
- val to_octets : t -> string
-end = struct
- open Crypto
-
- type r = R.r
- type t = EddsaSignature.t
-
- let to_string = Bin.to_string R.bin
- let sign_f ~f r = f (to_string r)
- let verify_f ~f t r = f t ~msg:(to_string r)
- let jsont = EddsaSignature.jsont
- let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti
- let to_octets t = EddsaSignature.to_octets t
-end
-
-module DenominationKeyAnnouncement = struct
- module R = struct
- (* CS: use purpose TALER_SIGNATURE_SM_CS_DENOMINATION_KEY *)
- (* purpose.purpose = TALER_SIGNATURE_SM_RSA_DENOMINATION_KEY *)
- type r = {
- h_denom_pub: DenominationHash.t;
- h_section_name: Hash.Cstring.H64.t;
- anchor_time: TimestampNBO.t;
- duration_withdraw: TimeRelativeNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.sm_rsa_denomination_key
- @@ fun purpose ->
- record
- (fun
- _purpose h_denom_pub h_section_name anchor_time duration_withdraw ->
- { h_denom_pub; h_section_name; anchor_time; duration_withdraw })
- |+ Purpose.field purpose
- |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_section_name)
- |+ field TimestampNBO.bin (fun t -> t.anchor_time)
- |+ field TimeRelativeNBO.bin (fun t -> t.duration_withdraw)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module SigningKeyAnnouncement = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_SM_SIGNING_KEY *)
- type r = {
- exchange_pub: ExchangePublicKeyP.t;
- anchor_time: TimestampNBO.t;
- duration: TimeRelativeNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.sm_signing_key @@ fun purpose ->
- record (fun _purpose exchange_pub anchor_time duration ->
- { exchange_pub; anchor_time; duration })
- |+ Purpose.field purpose
- |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
- |+ field TimestampNBO.bin (fun t -> t.anchor_time)
- |+ field TimeRelativeNBO.bin (fun t -> t.duration)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module DenominationKeyValidity = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_VALIDITY *)
- type r = {
- master: MasterPublicKeyP.t;
- start: TimestampNBO.t;
- expire_withdraw: TimestampNBO.t;
- expire_spend: TimestampNBO.t;
- expire_legal: TimestampNBO.t;
- value: AmountNBO.t;
- fee_withdraw: AmountNBO.t;
- fee_deposit: AmountNBO.t;
- fee_refresh: AmountNBO.t;
- (* TODO signatures taler doc *)
- fee_refund: AmountNBO.t;
- denom_hash: DenominationHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_denomination_key_validity
- @@ fun purpose ->
- record
- (fun
- _purpose
- master
- start
- expire_withdraw
- expire_spend
- expire_legal
- value
- fee_withdraw
- fee_deposit
- fee_refresh
- fee_refund
- denom_hash
- ->
- {
- master;
- start;
- expire_withdraw;
- expire_spend;
- expire_legal;
- value;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- denom_hash;
- })
- |+ Purpose.field purpose
- |+ field MasterPublicKeyP.bin (fun t -> t.master)
- |+ field TimestampNBO.bin (fun t -> t.start)
- |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
- |+ field TimestampNBO.bin (fun t -> t.expire_spend)
- |+ field TimestampNBO.bin (fun t -> t.expire_legal)
- |+ field AmountNBO.bin (fun t -> t.value)
- |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
- |+ field AmountNBO.bin (fun t -> t.fee_deposit)
- |+ field AmountNBO.bin (fun t -> t.fee_refresh)
- |+ field AmountNBO.bin (fun t -> t.fee_refund)
- |+ field DenominationHash.bin (fun t -> t.denom_hash)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module ExchangeSigningKeyValidity = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_VALIDITY *)
- type r = {
- start: TimestampNBO.t;
- expire: TimestampNBO.t;
- end_: TimestampNBO.t;
- signkey_pub: ExchangePublicKeyP.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_signing_key_validity
- @@ fun purpose ->
- record (fun _purpose start expire end_ signkey_pub ->
- { start; expire; end_; signkey_pub })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.start)
- |+ field TimestampNBO.bin (fun t -> t.expire)
- |+ field TimestampNBO.bin (fun t -> t.end_)
- |+ field ExchangePublicKeyP.bin (fun t -> t.signkey_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDenominationKeyRevocation = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_REVOKED. *)
- type r = { h_denom_pub: DenominationHash.t }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_denomination_key_revoked
- @@ fun purpose ->
- record (fun _purpose h_denom_pub -> { h_denom_pub })
- |+ Purpose.field purpose
- |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterSigningKeyRevocation = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_REVOKED *)
- type r = { exchange_pub: ExchangePublicKeyP.t }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_signing_key_revoked
- @@ fun purpose ->
- record (fun _purpose exchange_pub -> { exchange_pub })
- |+ Purpose.field purpose
- |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterAddAuditor = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_AUDITOR *)
- type r = {
- start_date: TimestampNBO.t;
- auditor_pub: AuditorPublicKeyP.t;
- h_auditor_url: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_add_auditor @@ fun purpose ->
- record (fun _purpose start_date auditor_pub h_auditor_url ->
- { start_date; auditor_pub; h_auditor_url })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_auditor_url)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDelAuditor = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_AUDITOR *)
- type r = {
- end_date: TimestampNBO.t;
- auditor_pub: AuditorPublicKeyP.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_del_auditor @@ fun purpose ->
- record (fun _purpose end_date auditor_pub -> { end_date; auditor_pub })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module GlobalFees = struct
- module R = struct
- (* TODO signatures taler doc *)
- (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *)
- type r = {
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- purse_timeout: TimeRelativeNBO.t;
- history_expiration: TimeRelativeNBO.t;
- history_fee: AmountNBO.t;
- account_fee: AmountNBO.t;
- purse_fee: AmountNBO.t;
- purse_account_limit: int32;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_global_fees @@ fun purpose ->
- record
- (fun
- _purpose
- start_date
- end_date
- purse_timeout
- history_expiration
- history_fee
- account_fee
- purse_fee
- purse_account_limit
- ->
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field TimeRelativeNBO.bin (fun t -> t.purse_timeout)
- |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration)
- |+ field AmountNBO.bin (fun t -> t.history_fee)
- |+ field AmountNBO.bin (fun t -> t.account_fee)
- |+ field AmountNBO.bin (fun t -> t.purse_fee)
- |+ field beint32 (fun t -> t.purse_account_limit)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterWireDetails = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_DETAILS *)
- type r = {
- h_wire_details: FullPaytoHash.t;
- h_conversion_url: Hash.Cstring.H64.t;
- h_credit_restrictions: Hash.Cstring.H64.t;
- h_debit_restrictions: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_wire_details @@ fun purpose ->
- record
- (fun
- _purpose
- h_wire_details
- h_conversion_url
- h_credit_restrictions
- h_debit_restrictions
- ->
- {
- h_wire_details;
- h_conversion_url;
- h_credit_restrictions;
- h_debit_restrictions;
- })
- |+ Purpose.field purpose
- |+ field FullPaytoHash.bin (fun t -> t.h_wire_details)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterAddWire = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_WIRE *)
- type r = {
- start_date: TimestampNBO.t;
- h_wire: FullPaytoHash.t;
- h_conversion_url: Hash.Cstring.H64.t;
- h_credit_restrictions: Hash.Cstring.H64.t;
- h_debit_restrictions: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_add_wire @@ fun _purpose ->
- record
- (fun
- _purpose
- start_date
- h_wire
- h_conversion_url
- h_credit_restrictions
- h_debit_restrictions
- ->
- {
- start_date;
- h_wire;
- h_conversion_url;
- h_credit_restrictions;
- h_debit_restrictions;
- })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field FullPaytoHash.bin (fun t -> t.h_wire)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDelWire = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_WIRE *)
- type r = {
- end_date: TimestampNBO.t;
- h_wire: FullPaytoHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_del_wire @@ fun _purpose ->
- record (fun _purpose end_date h_wire -> { end_date; h_wire })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field FullPaytoHash.bin (fun t -> t.h_wire)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDrainProfit = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DRAIN_PROFITS *)
- type r = {
- wtid: WireTransferIdentifierRawP.t;
- date: TimestampNBO.t;
- amount: AmountNBO.t;
- h_section: Hash.Cstring.H64.t;
- h_payto: FullPaytoHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_drain_profit @@ fun _purpose ->
- record (fun _purpose wtid date amount h_section h_payto ->
- { wtid; date; amount; h_section; h_payto })
- |+ Purpose.field _purpose
- |+ field WireTransferIdentifierRawP.bin (fun t -> t.wtid)
- |+ field TimestampNBO.bin (fun t -> t.date)
- |+ field AmountNBO.bin (fun t -> t.amount)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_section)
- |+ field FullPaytoHash.bin (fun t -> t.h_payto)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterAmlOfficerStatus = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_AML_KEY *)
- type r = {
- change_date: TimestampNBO.t;
- officer_pub: AmlOfficerPublicKeyP.t;
- h_officer_name: Hash.Cstring.H64.t;
- is_active: int32;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_aml_key @@ fun _purpose ->
- record (fun _purpose change_date officer_pub h_officer_name is_active ->
- { change_date; officer_pub; h_officer_name; is_active })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.change_date)
- |+ field AmlOfficerPublicKeyP.bin (fun t -> t.officer_pub)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_officer_name)
- |+ field beint32 (fun t -> t.is_active)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module PartnerConfiguration = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_PARNTER_DETAILS *)
- type r = {
- partner_pub: MasterPublicKeyP.t;
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- wad_frequency: TimeRelativeNBO.t;
- wad_fee: AmountNBO.t;
- h_url: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_partner_details
- @@ fun _purpose ->
- record
- (fun
- _purpose
- partner_pub
- start_date
- end_date
- wad_frequency
- wad_fee
- h_url
- -> { partner_pub; start_date; end_date; wad_frequency; wad_fee; h_url })
- |+ Purpose.field _purpose
- |+ field MasterPublicKeyP.bin (fun t -> t.partner_pub)
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
- |+ field AmountNBO.bin (fun t -> t.wad_fee)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_url)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module WadPartnerSignature = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_PARTNER_DETAILS *)
- type r = {
- h_partner_base_url: Hash.Cstring.H64.t;
- master_public_key: MasterPublicKeyP.t;
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- wad_fee: AmountNBO.t;
- wad_frequency: TimeRelativeNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_partner_details
- @@ fun _purpose ->
- record
- (fun
- _purpose
- h_partner_base_url
- master_public_key
- start_date
- end_date
- wad_fee
- wad_frequency
- ->
- {
- h_partner_base_url;
- master_public_key;
- start_date;
- end_date;
- wad_fee;
- wad_frequency;
- })
- |+ Purpose.field _purpose
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_partner_base_url)
- |+ field MasterPublicKeyP.bin (fun t -> t.master_public_key)
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field AmountNBO.bin (fun t -> t.wad_fee)
- |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterWireFee = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_FEES *)
- type r = {
- h_wire_method: Hash.Cstring.H64.t;
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- wire_fee: AmountNBO.t;
- closing_fee: AmountNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_wire_fees @@ fun _purpose ->
- record
- (fun _purpose h_wire_method start_date end_date wire_fee closing_fee ->
- { h_wire_method; start_date; end_date; wire_fee; closing_fee })
- |+ Purpose.field _purpose
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_wire_method)
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field AmountNBO.bin (fun t -> t.wire_fee)
- |+ field AmountNBO.bin (fun t -> t.closing_fee)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module ExchangeKeyValidity = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_AUDITOR_EXCHANGE_KEYS *)
- type r = {
- auditor_url_hash: Hash.Cstring.H64.t;
- master: MasterPublicKeyP.t;
- start: TimestampNBO.t;
- expire_withdraw: TimestampNBO.t;
- expire_spend: TimestampNBO.t;
- expire_legal: TimestampNBO.t;
- value: AmountNBO.t;
- fee_withdraw: AmountNBO.t;
- fee_deposit: AmountNBO.t;
- fee_refresh: AmountNBO.t;
- denom_hash: DenominationHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.auditor_exchange_keys @@ fun _purpose ->
- record
- (fun
- _purpose
- auditor_url_hash
- master
- start
- expire_withdraw
- expire_spend
- expire_legal
- value
- fee_withdraw
- fee_deposit
- fee_refresh
- denom_hash
- ->
- {
- auditor_url_hash;
- master;
- start;
- expire_withdraw;
- expire_spend;
- expire_legal;
- value;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- denom_hash;
- })
- |+ Purpose.field _purpose
- |+ field Hash.Cstring.H64.bin (fun t -> t.auditor_url_hash)
- |+ field MasterPublicKeyP.bin (fun t -> t.master)
- |+ field TimestampNBO.bin (fun t -> t.start)
- |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
- |+ field TimestampNBO.bin (fun t -> t.expire_spend)
- |+ field TimestampNBO.bin (fun t -> t.expire_legal)
- |+ field AmountNBO.bin (fun t -> t.value)
- |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
- |+ field AmountNBO.bin (fun t -> t.fee_deposit)
- |+ field AmountNBO.bin (fun t -> t.fee_refresh)
- |+ field DenominationHash.bin (fun t -> t.denom_hash)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module ExchangeKeySet = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_KEY_SET *)
- type r = {
- list_issue_date: TimestampNBO.t;
- (* hash over a concatenation of master_sigs *)
- hc: H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.exchange_key_set @@ fun _purpose ->
- record (fun _purpose list_issue_date hc -> { list_issue_date; hc })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.list_issue_date)
- |+ field H64.bin (fun t -> t.hc)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-(* ### BIN IMPL END ### *)
-
-module WithdrawRequest = struct
- (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
- type t = {
- amount: Amount.t;
- fee: Amount.t;
- h_planchets: HashPlanchetsP.t;
- blinding_seed: BlindingMasterSecret.t;
- max_age_group: int32;
- mask: AgeMask.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.wallet_reserve_withdraw @@ fun purpose ->
- record
- (fun _purpose amount fee h_planchets blinding_seed max_age_group mask ->
- { amount; fee; h_planchets; blinding_seed; max_age_group; mask })
- |+ Purpose.field purpose
- |+ field Amount.bin (fun t -> t.amount)
- |+ field Amount.bin (fun t -> t.fee)
- |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
- |+ field BlindingMasterSecret.bin (fun t -> t.blinding_seed)
- |+ field beint32 (fun t -> t.max_age_group)
- |+ field AgeMask.bin (fun t -> t.mask)
- |> sealr
-end
-
-module WithdrawConfirmation = struct
- (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW *)
- type t = {
- h_planchets: HashPlanchetsP.t;
- noreveal_index: int32;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.exchange_confirm_withdraw
- @@ fun purpose ->
- record (fun _purpose h_planchets noreveal_index ->
- { h_planchets; noreveal_index })
- |+ Purpose.field purpose
- |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
- |+ field beint32 (fun t -> t.noreveal_index)
- |> sealr
-end
-
-module SingleWithdrawRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
- type t = {
- amount_with_fee: AmountNBO.t;
- h_denomination_pub: DenominationHash.t;
- h_coin_envelope: BlindedCoinHash.t;
- }
-end
-
-module DepositRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_DEPOSIT *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_age_commitment: AgeCommitmentHash.t;
- h_policy: ExtensionsPolicyHash.t;
- h_wire: MerchantWireHash.t;
- h_denom_pub: DenominationHash.t;
- timestamp: TimestampNBO.t;
- refund_deadline: TimestampNBO.t;
- amount_with_fee: AmountNBO.t;
- deposit_fee: AmountNBO.t;
- merchant: MerchantPublicKeyP.t;
- wallet_data_hash: Hash.Cstring.H64.t;
- }
-end
-
-module DepositConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_DEPOSIT *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_wire: MerchantWireHash.t;
- h_policy: ExtensionsPolicyHash.t;
- timestamp: TimestampNBO.t;
- refund_deadline: TimestampNBO.t;
- amount_without_fee: AmountNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- merchant: MerchantPublicKeyP.t;
- }
-end
-
-module RefreshMeltCoinAffirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_MELT *)
- type t = {
- session_hash: RefreshCommitmentP.t;
- h_denom_pub: DenominationHash.t;
- h_age_commitment: AgeCommitmentHash.t;
- amount_with_fee: AmountNBO.t;
- melt_fee: AmountNBO.t;
- }
-end
-
-module RefreshMeltConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_MELT *)
- type t = {
- session_hash: RefreshCommitmentP.t;
- noreveal_index: int; (* uint16_t mapped to OCaml int *)
- }
-end
-
-module DepositTrack = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_wire: MerchantWireHash.t;
- coin_pub: CoinSpendPublicKeyP.t;
- }
-end
-
-module WireDepositDetailP = struct
- type t = {
- h_contract_terms: PrivateContractHash.t;
- execution_time: TimestampNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- deposit_value: AmountNBO.t;
- deposit_fee: AmountNBO.t;
- }
-end
-
-module WireDepositData = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE_DEPOSIT *)
- type t = {
- total: AmountNBO.t;
- wire_fee: AmountNBO.t;
- merchant_pub: MerchantPublicKeyP.t;
- h_wire: MerchantWireHash.t;
- h_details: Hash.Cstring.H64.t;
- }
-end
-
-module PaymentResponse = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_PAYMENT_OK *)
- type t = { h_contract_terms: PrivateContractHash.t }
-end
-
-module Contract = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_CONTRACT *)
- type t = { h_contract_terms: PrivateContractHash.t }
-end
-
-module ConfirmWire = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE *)
- type t = {
- h_wire: MerchantWireHash.t;
- h_contract_terms: PrivateContractHash.t;
- wtid: WireTransferIdentifierRawP.t;
- coin_pub: CoinSpendPublicKeyP.t;
- execution_time: TimestampNBO.t;
- coin_contribution: AmountNBO.t;
- }
-end
-
-module RefundConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_REFUND *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- coin_pub: CoinSpendPublicKeyP.t;
- merchant: MerchantPublicKeyP.t;
- rtransaction_id: int64;
- refund_amount: AmountNBO.t;
- }
-end
-
-module DepositTrackPS2 = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_wire: MerchantWireHash.t;
- merchant: MerchantPublicKeyP.t;
- coin_pub: CoinSpendPublicKeyP.t;
- }
-end
-
-module RefundRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- coin_pub: CoinSpendPublicKeyP.t;
- rtransaction_id: int64;
- refund_amount: AmountNBO.t;
- refund_fee: AmountNBO.t;
- }
-end
-
-module MerchantRefundConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND_OK *)
- (* Hash of the order ID (a string), hashed without the 0-termination. *)
- type t = { h_order_id: Hash.Cstring.H64.t }
-end
-
-module RecoupRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_RECOUP or TALER_SIGNATURE_WALLET_COIN_RECOUP_REFRESH *)
- type t = {
- h_denom_pub: DenominationHash.t;
- coin_blind: DenominationBlindingKeyP.t;
- }
-end
-
-module RecoupRefreshConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP_REFRESH *)
- type t = {
- timestamp: TimestampNBO.t;
- recoup_amount: AmountNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- old_coin_pub: CoinSpendPublicKeyP.t;
- }
-end
-
-module RecoupConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP *)
- type t = {
- timestamp: TimestampNBO.t;
- recoup_amount: AmountNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- reserve_pub: ReservePublicKeyP.t;
- }
-end
-
-module DenominationUnknownAffirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_AFFIRM_DENOM_UNKNOWN *)
- type t = {
- timestamp: TimestampNBO.t;
- h_denom_pub: DenominationHash.t;
- }
-end
-
-module DenominationExpiredAffirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_GENERIC_DENOMINATIN_EXPIRED *)
- type t = {
- timestamp: TimestampNBO.t;
- operation: string; (* char[8] → string *)
- h_denom_pub: DenominationHash.t;
- }
-end
-
-module ReserveCloseConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_CLOSED *)
- type t = {
- timestamp: TimestampNBO.t;
- closing_amount: AmountNBO.t;
- reserve_pub: ReservePublicKeyP.t;
- h_wire: FullPaytoHash.t;
- }
-end
-
-module CoinLinkSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
- type t = {
- h_denom_pub: DenominationHash.t;
- old_coin_pub: CoinSpendPublicKeyP.t;
- transfer_pub: TransferPublicKeyP.t;
- coin_envelope_hash: BlindedCoinHash.t;
- }
-end
-
-module RefreshNonceSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
- type t = { nonce: PublicRefreshCoinNonceP.t }
-end
-
-module ReserveStatusRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_RESERVE_STATUS_REQUEST *)
- type t = { request_timestamp: TimestampNBO.t }
-end
-
-module ReserveHistoryRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_RESERVE_HISTORY_REQUEST *)
- type t = {
- history_fee: AmountNBO.t;
- request_timestamp: TimestampNBO.t;
- }
-end
-
-module PurseStatusRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_REQUEST *)
- type t = unit
-end
-
-module PurseStatusResponseSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_RESPONSE *)
- type t = {
- total_purse_amount: AmountNBO.t;
- total_deposit_amount: AmountNBO.t;
- max_deposit_fees: AmountNBO.t;
- purse_expiration: TimestampNBO.t;
- status_timestamp: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- }
-end
-
-module ReserveCloseRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
- type t = unit
-end
-
-module PurseRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_CREATE *)
- type t = {
- purse_expiration: TimestampNBO.t;
- merge_value_after_fees: AmountNBO.t;
- h_contract_terms: PrivateContractHash.t;
- min_age: int;
- }
-end
-
-module PurseDepositSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT *)
- type t = {
- coin_contribution: AmountNBO.t;
- h_denom_pub: DenominationHash.t;
- h_age_commitment: AgeCommitmentHash.t;
- purse_pub: PursePublicKey.t;
- h_exchange_base_url: Hash.Cstring.H64.t;
- }
-end
-
-module PurseDepositSignaturePS2 = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN_DEPOSIT *)
- type t = {
- reserve_sig: ReserveSignatureP.t;
- coin_contribution: AmountNBO.t;
- }
-end
-
-module PurseDepositConfirmedSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT_CONFIRMED *)
- type t = {
- total_purse_amount: AmountNBO.t;
- total_deposit_fees: AmountNBO.t;
- purse_pub: PursePublicKey.t;
- purse_expiration: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- }
-end
-
-module PurseMergeSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_MERGE *)
- type t = {
- merge_timestamp: TimestampNBO.t;
- h_wire: NormalizedPaytoHash.t;
- }
-end
-
-module AccountMergeSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_MERGE *)
- type t = {
- reserve_pub: ReservePublicKeyP.t;
- purse_pub: PursePublicKey.t;
- merge_amount_after_fees: AmountNBO.t;
- merge_timestamp: TimestampNBO.t;
- purse_expiration: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- min_age: int;
- }
-end
-
-module AccountSetupRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_SETUP *)
- type t = { threshold: AmountNBO.t }
-end
-
-module PurseMergeSuccessSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_MERGE_SUCCESS *)
- type t = {
- reserve_pub: ReservePublicKeyP.t;
- purse_pub: PursePublicKey.t;
- merge_amount_after_fees: AmountNBO.t;
- contract_time: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- h_wire: NormalizedPaytoHash.t;
- min_age: int;
- }
-end
-
-module WadDataSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WAD_DATA *)
- type t = {
- wad_execution_time: TimestampNBO.t;
- total_amount: AmountNBO.t;
- h_items: Hash.Cstring.H64.t;
- wad_id: WadId.t;
- }
-end
-
-module P2PFees = struct
- (* purpose.purpose = TALER_SIGNATURE_P2P_FEES *)
- type t = {
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- kyc_fee: AmountNBO.t;
- purse_fee: AmountNBO.t;
- account_history_fee: AmountNBO.t;
- account_annual_fee: AmountNBO.t;
- account_kyc_timeout: TimeRelativeNBO.t;
- purse_timeout: TimeRelativeNBO.t;
- purse_account_limit: int;
- }
-end
-
-module CoinPurseRefundConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_PURSE_REFUND *)
- type t = {
- purse_pub: PursePublicKey.t;
- coin_pub: CoinSpendPublicKeyP.t;
- refunded_amount: AmountNBO.t;
- refund_fee: AmountNBO.t;
- }
-end
-
-module AmlDecision = struct
- (* purpose.purpose = TALER_SIGNATURE_AML_DECISION *)
- type t = {
- h_justification: Hash.Cstring.H64.t;
- decision_time: TimestampNBO.t;
- new_threshold: AmountNBO.t;
- h_payto: NormalizedPaytoHash.t;
- h_kyc_requirements: Hash.Cstring.H64.t;
- new_state: int;
- }
-end
-
-module ReserveOpen = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN *)
- type t = {
- reserve_payment: AmountNBO.t;
- request_timestamp: TimestampNBO.t;
- reserve_expiration: TimestampNBO.t;
- purse_limit: int;
- }
-end
-
-module ReserveClose = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
- type t = {
- request_timestamp: TimestampNBO.t;
- target_account_h_payto: FullPaytoHash.t;
- }
-end
-
-module ReserveAttestRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_ATTEST_REQUEST *)
- type t = {
- request_timestamp: TimestampNBO.t;
- h_details: Hash.Cstring.H64.t;
- }
-end
-
-module ExchangeAttest = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_ATTEST_DETAILS *)
- type t = {
- attest_timestamp: TimestampNBO.t;
- expiration_time: TimestampNBO.t;
- reserve_pub: ReservePublicKeyP.t;
- h_attributes: Hash.Cstring.H64.t;
- }
-end
diff --git a/.jjconflict-side-0/src/signkey.ml b/.jjconflict-side-0/src/signkey.ml
deleted file mode 100644
index a710aee6..00000000
--- a/.jjconflict-side-0/src/signkey.ml
+++ /dev/null
@@ -1,11 +0,0 @@
-open Crypto
-
-(* TODO replace by Api.SignKey.t instead? (no revoked_sig) *)
-type t = {
- pub: eddsa_pub;
- stamp_start: Timestamp.t;
- stamp_expire: Timestamp.t;
- stamp_end: Timestamp.t;
- master_sig: Signatures.ExchangeSigningKeyValidity.t;
- revoked_sig: Signatures.MasterSigningKeyRevocation.t option;
-}
diff --git a/.jjconflict-side-0/src/syntax.ml b/.jjconflict-side-0/src/syntax.ml
deleted file mode 100644
index c61aba15..00000000
--- a/.jjconflict-side-0/src/syntax.ml
+++ /dev/null
@@ -1,51 +0,0 @@
-let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
-let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e
-
-(* TODO use polymorphic variant for errors *)
-let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
-
-let unwrap_err_caqti o =
- match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
-
-let list_iter f l =
- let err = ref None in
- try
- List.iter
- (fun v ->
- match f v with
- | Error _e as e ->
- err := Some e;
- raise Exit
- | Ok () -> ())
- l;
- Ok ()
- with Exit -> ( match !err with None -> assert false | Some v -> v)
-
-let list_map f l =
- let err = ref None in
- try
- Ok
- (List.map
- (fun v ->
- match f v with
- | Error _e as e ->
- err := Some e;
- raise Exit
- | Ok v -> v)
- l)
- with Exit -> ( match !err with None -> assert false | Some v -> v)
-
-let list_fold_left f acc l =
- List.fold_left
- (fun acc v ->
- let* acc = acc in
- f acc v)
- (Ok acc) l
-
-let opt_list l =
- match (List.for_all Option.is_none l, List.for_all Option.is_some l) with
- | _, true ->
- let l = List.map Option.get l in
- Ok (Some l)
- | true, _ -> Ok None
- | _, _ -> Error ()
diff --git a/.jjconflict-side-0/src/taler_signatures.ml b/.jjconflict-side-0/src/taler_signatures.ml
deleted file mode 100644
index 8715b472..00000000
--- a/.jjconflict-side-0/src/taler_signatures.ml
+++ /dev/null
@@ -1,280 +0,0 @@
-(* This file was generated from the GANA database:
- https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)
-
-(** Initialize or update the status of an AML key for an AML officer *)
-let master_aml_key : int32 = 1017_l
-
-(** Affirm wiring of exchange profits to operator account. *)
-let master_drain_profit : int32 = 1018_l
-
-(** Signature affirming a partner configuration for wads. *)
-let master_partner_details : int32 = 1019_l
-
-(** The given revocation key was revoked and must no longer be used. *)
-let master_signing_key_revoked : int32 = 1020_l
-
-(** Add payto URI to the list of our wire methods. *)
-let master_add_wire : int32 = 1021_l
-
-(** Signature over global set of fees charged by the exchange. *)
-let master_global_fees : int32 = 1022_l
-
-(** Remove payto URI from the list of our wire methods. *)
-let master_del_wire : int32 = 1023_l
-
-(** Purpose for signing public keys signed by the exchange master key. *)
-let master_signing_key_validity : int32 = 1024_l
-
-(** Purpose for denomination keys signed by the exchange master key. *)
-let master_denomination_key_validity : int32 = 1025_l
-
-(** Add an auditor to the list of our auditors. *)
-let master_add_auditor : int32 = 1026_l
-
-(** Remove an auditor from the list of our auditors. *)
-let master_del_auditor : int32 = 1027_l
-
-(** Fees charged per (aggregate) wire transfer to the merchant. *)
-let master_wire_fees : int32 = 1028_l
-
-(** The given revocation key was revoked and must no longer be used. *)
-let master_denomination_key_revoked : int32 = 1029_l
-
-(** Signature where the Exchange confirms its IBAN details in the /wire
- response. *)
-let master_wire_details : int32 = 1030_l
-
-(** Set the configuration of an extension (age-restriction or peer2peer) *)
-let master_extension : int32 = 1031_l
-
-(** Purpose for the state of a reserve, signed by the exchange's signing key. *)
-let exchange_reserve_status : int32 = 1032_l
-
-(** Signature where the Exchange confirms a deposit request. *)
-let exchange_confirm_deposit : int32 = 1033_l
-
-(** Signature where the exchange (current signing key) confirms the no-reveal
- index for cut-and-choose and the validity of the melted coins. *)
-let exchange_confirm_melt : int32 = 1034_l
-
-(** Signature where the Exchange confirms the full /keys response set. *)
-let exchange_key_set : int32 = 1035_l
-
-(** Signature where the Exchange confirms the /track/transaction response. *)
-let exchange_confirm_wire : int32 = 1036_l
-
-(** Signature where the Exchange confirms the /wire/deposit response. *)
-let exchange_confirm_wire_deposit : int32 = 1037_l
-
-(** Signature where the Exchange confirms a refund request. *)
-let exchange_confirm_refund : int32 = 1038_l
-
-(** Signature where the Exchange confirms a recoup. *)
-let exchange_confirm_recoup : int32 = 1039_l
-
-(** Signature where the Exchange confirms it closed a reserve. *)
-let exchange_reserve_closed : int32 = 1040_l
-
-(** Signature where the Exchange confirms a recoup-refresh operation. *)
-let exchange_confirm_recoup_refresh : int32 = 1041_l
-
-(** Signature where the Exchange confirms that it does not know a denomination
- (hash). *)
-let exchange_affirm_denom_unknown : int32 = 1042_l
-
-(** Signature where the Exchange confirms that it does not consider a
- denomination valid for the given operation at this time. *)
-let exchange_affirm_denom_expired : int32 = 1043_l
-
-(** Signature by which the exchange affirms that a purse was created with a
- certain amount deposited into it. *)
-let exchange_confirm_purse_creation : int32 = 1045_l
-
-(** Signature by which the exchange affirms that a purse was merged into a
- reserve with a certain amount in it. *)
-let exchange_confirm_purse_merged : int32 = 1046_l
-
-(** Purpose for the state of a purse, signed by the exchange's signing key. *)
-let exchange_purse_status : int32 = 1047_l
-
-(** Signature by which the exchange attests identity attributes of a particular
- reserve owner. *)
-let exchange_reserve_attest_details : int32 = 1048_l
-
-(** Signature by which the exchange confirms that a purse expired and a coin was
- refunded. *)
-let exchange_confirm_purse_refund : int32 = 1049_l
-
-(** Signature where the Exchange confirms an (age-)withdraw. *)
-let exchange_confirm_withdraw : int32 = 1050_l
-
-(** Signature where the auditor confirms that he is aware of certain
- denomination keys from the exchange. *)
-let auditor_exchange_keys : int32 = 1064_l
-
-(** Signature where the merchant confirms a contract (to the customer). *)
-let merchant_contract : int32 = 1101_l
-
-(** Signature where the merchant confirms a refund (of a coin). *)
-let merchant_refund : int32 = 1102_l
-
-(** Signature where the merchant confirms that he needs the wire transfer
- identifier for a deposit operation. *)
-let merchant_track_transaction : int32 = 1103_l
-
-(** Signature where the merchant confirms that the payment was successful *)
-let merchant_payment_ok : int32 = 1104_l
-
-(** Signature where the merchant confirms its own (salted) wire details (not yet
- really used). *)
-let merchant_wire_details : int32 = 1107_l
-
-(** Signature where the merchant issues a token by blindly signing it. Signed
- with the token issue private key. *)
-let merchant_token_issue : int32 = 1108_l
-
-(** Signature where the reserve key confirms a withdraw request. Signed with the
- reserve private key. *)
-let wallet_reserve_withdraw : int32 = 1200_l
-
-(** Signature made by the wallet of a user to confirm a deposit of a coin. *)
-let wallet_coin_deposit : int32 = 1201_l
-
-(** Signature using a coin key confirming the melting of a coin. Signed with the
- coin's private key. *)
-let wallet_coin_melt : int32 = 1202_l
-
-(** Signature using a coin key requesting recoup. Signed with the coin's private
- key. *)
-let wallet_coin_recoup : int32 = 1203_l
-
-(** Signature using a coin key authenticating link data. Signed with the old
- coin's private key. *)
-let wallet_coin_link : int32 = 1204_l
-
-(** Signature using a reserve key by which a wallet requests a payment target
- UUID for itself. Signs over just a purpose (no body), as the signature only
- serves to demonstrate that the request comes from the wallet controlling the
- private key, and not some third party. *)
-let wallet_account_setup : int32 = 1205_l
-
-(** Signature using a coin key requesting recoup-refresh. Signed with the coin
- private key. *)
-let wallet_coin_recoup_refresh : int32 = 1206_l
-
-(** Signature using a age restriction key for attestation of a particular
- age/age-group. *)
-let wallet_age_attestation : int32 = 1207_l
-
-(** Request full or partial reserve history. Signed with the reserve private
- key. *)
-let wallet_reserve_history : int32 = 1208_l
-
-(** Request full or partial coin history. Signed with the coin private key. *)
-let wallet_coin_history : int32 = 1209_l
-
-(** Request purse creation (without reserve). Signed by the purse private key.
-*)
-let wallet_purse_create : int32 = 1210_l
-
-(** Request coin to be deposited into a purse. Signed with the coin private key.
-*)
-let wallet_purse_deposit : int32 = 1211_l
-
-(** Request purse status. Signed with the purse private key. *)
-let wallet_purse_status : int32 = 1212_l
-
-(** Request purse to be merged with a reserve. Signed with the purse private
- key. *)
-let wallet_purse_merge : int32 = 1213_l
-
-(** Request purse to be merged with a reserve. Signed by the reserve private
- key. *)
-let wallet_account_merge : int32 = 1214_l
-
-(** Request account to be closed. Signed with the reserve private key. *)
-let wallet_reserve_close : int32 = 1215_l
-
-(** Associates encrypted contract with a purse. Signed with the purse private
- key. *)
-let wallet_purse_econtract : int32 = 1216_l
-
-(** Request reserve to be kept open. Signed with the reserve private key. *)
-let wallet_reserve_open : int32 = 1217_l
-
-(** Request coin to be used to pay for reserve to be kept open. Signed with the
- coin private key. *)
-let wallet_reserve_open_deposit : int32 = 1218_l
-
-(** Request attestation about reserve owner. Signed by the reserve private key.
-*)
-let wallet_reserve_attest_details : int32 = 1219_l
-
-(** Signature by which a wallet requests a purse to be deleted. *)
-let wallet_purse_delete : int32 = 1220_l
-
-(** Signature where the reserve key confirms an age-withdraw request. Signed
- with the reserve private key. *)
-let wallet_reserve_age_withdraw : int32 = 1221_l
-
-(** Signature where the token use key confirms the usage of a token on a pay
- request. Signed with the token use private key. *)
-let wallet_token_use : int32 = 1222_l
-
-(** Signature used to unclaim an order, allowing other wallets to claim it.
- Signed with the private key of the claim nonce. *)
-let wallet_order_unclaim : int32 = 1223_l
-
-(** Signature on a denomination key announcement. *)
-let sm_rsa_denomination_key : int32 = 1250_l
-
-(** Signature on an exchange message signing key announcement. *)
-let sm_signing_key : int32 = 1251_l
-
-(** Signature on a denomination key announcement. *)
-let sm_cs_denomination_key : int32 = 1252_l
-
-(** EdDSA test signature. *)
-let client_test_eddsa : int32 = 1302_l
-
-(** EdDSA test signature. *)
-let exchange_test_eddsa : int32 = 1303_l
-
-(** Signature by which an AML officer signs an AML decision. *)
-let aml_decision : int32 = 1350_l
-
-(** Signature by which an AML officer requests AML data. *)
-let aml_query : int32 = 1351_l
-
-(** Signature by which an account owner authorizes access to a KYC operation. *)
-let kyc_auth : int32 = 1360_l
-
-(** EdDSA signature for a policy upload. *)
-let anastasis_policy_upload : int32 = 1400_l
-
-(** EdDSA signature for a backup upload. *)
-let sync_backup_upload : int32 = 1450_l
-
-(** The signature is done by the Donau. The Donau signes over the total amount
- of the corresponding year, the corresponding year and the donation
- identifier of a specific donor. The statement confirms that the donor made
- this total in donations for the given year. *)
-let donau_donation_statement : int32 = 1500_l
-
-(** The signature is made by a charity and shows that the charity is in
- agreement with the donation request which it sends to the Donau. The charity
- signs over all blinded identifiers and key pairs which it has received from
- the donor. The signature affirms that the charity wants the donation
- receipts to be issued on its behalf. *)
-let charity_donation_confirmation : int32 = 1501_l
-
-(** The signature is made by a charity to request information about its status
- from a Donau. It is not over anything in particular and is just there for
- access control. *)
-let charity_get_info : int32 = 1502_l
-
-(** Signature over messages to delete in the mailbox service *)
-let mailbox_messages_delete : int32 = 1551_l
-
-(** Signature for mailbox registration request *)
-let mailbox_register : int32 = 1552_l
diff --git a/.jjconflict-side-0/src/time.ml b/.jjconflict-side-0/src/time.ml
deleted file mode 100644
index 3c5af371..00000000
--- a/.jjconflict-side-0/src/time.ml
+++ /dev/null
@@ -1,151 +0,0 @@
-let uint64_max = Int64.minus_one
-
-module Relative = struct
- type t = Int64.t
-
- let forever = uint64_max
- let zero = 0L
- let compare = Int64.unsigned_compare
- let min a b = if compare a b < 0 then a else b
- let max a b = if compare a b > 0 then a else b
-
- (* forever if either argument is forever or on overflow; otherwise a + b *)
- let add a b =
- if a = forever || b = forever then forever
- else
- let v = Int64.add a b in
- if compare v a < 0 then forever else v
-
- (* zero if a <= b, or forever if a is forever; otherwise a - b *)
- let sub a b =
- if compare a b <= 0 then zero
- else if a = forever then forever
- else Int64.sub a b
-
- let of_s s =
- let v = Int64.mul s 1_000_000L in
- if Int64.unsigned_div v 1_000_000L <> s then forever else v
-
- let bin = Bin.neint64
- let bin_nbo = Bin.beint64
-
- (* TODO should be in NBO here? *)
- let caqti =
- let encode v = Ok v in
- let decode v = Ok v in
- Caqti_type.custom ~encode ~decode Caqti_type.int64
-
- (* TODO
- reject negative / non-integer values
- cap value at 2^53 - 1 inclusive *)
- let jsont =
- let jsont =
- let forever_jsont =
- let dec s =
- match s with
- | "forever" -> forever
- | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
- in
- let enc _t = "forever" in
- Jsont.map ~dec ~enc Jsont.string
- in
- let num_jsont = Jsont.int64 in
- let enc t = if t = forever then forever_jsont else num_jsont in
- Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc ()
- in
- Jsont.Object.map ~kind:"RelativeTime" Fun.id
- |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id
- |> Jsont.Object.finish
-end
-
-module Absolute = struct
- type t = Int64.t
-
- let never = uint64_max
- let zero = 0L
- let compare = Int64.unsigned_compare
- let min a b = if compare a b < 0 then a else b
- let max a b = if compare a b > 0 then a else b
-
- (* zero if a >= b; never if b=never; otherwise b - a *)
- let diff a b =
- if compare a b >= 0 then zero
- else if b = never then never
- else Int64.sub b a
-
- (* never if either argument is never/forever or on overflow; otherwise t + d *)
- let add t d =
- if t = never || d = never then never
- else
- let v = Int64.add t d in
- if compare v t < 0 then never else v
-
- (* zero if t <= d, or never if t is never; otherwise t - d *)
- let sub t d =
- if compare t d <= 0 then zero
- else if t = never then never
- else Int64.sub t d
-
- let of_s s =
- let v = Int64.mul s 1_000_000L in
- if Int64.unsigned_div v 1_000_000L <> s then never else v
-
- let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s
-end
-
-module Timestamp = struct
- type t = Int64.t
-
- let never = uint64_max
- let zero = 0L
- let compare = Int64.unsigned_compare
-
- (* zero if a >= b; never if b=never; otherwise b - a *)
- let diff a b =
- if compare a b >= 0 then zero
- else if b = never then never
- else Int64.sub b a
-
- let of_s s =
- let v = Int64.mul s 1_000_000L in
- if Int64.unsigned_div v 1_000_000L <> s then never else v
-
- let to_s t =
- if t = never then None else Some (Int64.unsigned_div t 1_000_000L)
-
- let of_absolute a =
- if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L)
-
- let of_ptime v = v |> Absolute.of_ptime |> of_absolute
- let bin = Bin.neint64
- let bin_nbo = Bin.beint64
-
- let caqti =
- let encode v = Ok v in
- let decode v = Ok v in
- Caqti_type.custom ~encode ~decode Caqti_type.int64
-
- let jsont =
- let jsont =
- let never_jsont =
- let dec s =
- match s with
- | "never" -> never
- | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
- in
- let enc _t = "never" in
- Jsont.map ~dec ~enc Jsont.string
- in
- let num_jsont =
- Jsont.map
- ~dec:(fun n -> of_s n)
- ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s)
- Jsont.int64
- in
- let enc t = if t = never then never_jsont else num_jsont in
- Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc ()
- in
- Jsont.Object.map ~kind:"Timestamp" Fun.id
- |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id
- |> Jsont.Object.finish
-end
diff --git a/.jjconflict-side-0/src/time.mli b/.jjconflict-side-0/src/time.mli
deleted file mode 100644
index 180df904..00000000
--- a/.jjconflict-side-0/src/time.mli
+++ /dev/null
@@ -1,54 +0,0 @@
-module Relative : sig
- type t
-
- val forever : t
- val zero : t
- val compare : t -> t -> int
- val min : t -> t -> t
- val max : t -> t -> t
- val add : t -> t -> t
- val sub : t -> t -> t
- val of_s : int64 -> t
-
- (* - *)
- val bin : t Bin.t
- val bin_nbo : t Bin.t
- val caqti : t Caqti_type.t
- val jsont : t Jsont.t
-end
-
-module Absolute : sig
- type t
-
- val never : t
- val zero : t
- val compare : t -> t -> int
- val min : t -> t -> t
- val max : t -> t -> t
- val diff : t -> t -> Relative.t
- val add : t -> Relative.t -> t
- val sub : t -> Relative.t -> t
- val of_s : int64 -> t
- val of_ptime : Ptime.t -> t
-end
-
-module Timestamp : sig
- type t
-
- val never : t
- val zero : t
- val compare : t -> t -> int
- val diff : t -> t -> Relative.t
- val of_s : int64 -> t
-
- (* none if t = never *)
- val to_s : t -> int64 option
- val of_absolute : Absolute.t -> t
- val of_ptime : Ptime.t -> t
-
- (* - *)
- val bin : t Bin.t
- val bin_nbo : t Bin.t
- val caqti : t Caqti_type.t
- val jsont : t Jsont.t
-end
diff --git a/.jjconflict-side-0/src/timestamp.ml b/.jjconflict-side-0/src/timestamp.ml
deleted file mode 100644
index 1a942758..00000000
--- a/.jjconflict-side-0/src/timestamp.ml
+++ /dev/null
@@ -1 +0,0 @@
-include Time.Timestamp
diff --git a/.jjconflict-side-0/src/util.ml b/.jjconflict-side-0/src/util.ml
deleted file mode 100644
index c690a009..00000000
--- a/.jjconflict-side-0/src/util.ml
+++ /dev/null
@@ -1,62 +0,0 @@
-module Log_reporter = struct
- let detail_tag : string Logs.Tag.def =
- Logs.Tag.def "Detail tag" ~doc:"" Fmt.string
-
- let detail s = Logs.Tag.(empty |> add detail_tag s)
- let time_anchor = Ptime_clock.now () |> Ptime.to_span
-
- let color_of_log_level = function
- | Logs.App -> `White
- | Error -> `Red
- | Warning -> `Yellow
- | Info -> `Blue
- | Debug -> `Magenta
-
- let reporter : Logs.reporter =
- let open Fmt in
- let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%04.02f")) in
- let pp_header ppf v =
- let color = color_of_log_level (fst v) in
- let pp = styled (`Fg color) Logs.pp_header in
- pf ppf "%a" pp v
- in
- let pp_src_name =
- let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in
- fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v
- in
- let pp_detail = option (styled `Green (fmt " (%s)")) in
- let report src lvl ~over k msgf =
- let ppf =
- match lvl with
- | Logs.App -> stdout
- | Error | Warning | Info | Debug -> stderr
- in
- let k _ppf = over (); k () in
- let with_detail h tags k user_fmt =
- let detail = Option.bind tags (Logs.Tag.find detail_tag) in
- let timestamp =
- Ptime.sub_span (Ptime_clock.now ()) time_anchor
- |> Option.map Ptime.to_float_s
- |> Option.value ~default:0.
- in
- let k ppf = kpf k ppf "%a@." pp_detail detail in
- let k ppf = kpf k ppf user_fmt in
- kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h)
- pp_src_name src
- in
- msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
- in
- { report }
-
- (* TODO logs
- - vif shouldn't use/set the default reporter
- - Log.err all `Internal_server_error response *)
- let setup () =
- let level = Some Logs.Info in
- Logs.set_level ~all:false level;
- Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
- Logs.Src.set_level Logs.default level;
- Logs_threaded.enable ();
- Logs.set_reporter reporter;
- ()
-end
diff --git a/.jjconflict-side-0/test/auditor_public_key b/.jjconflict-side-0/test/auditor_public_key
deleted file mode 100644
index 4b97fccf..00000000
--- a/.jjconflict-side-0/test/auditor_public_key
+++ /dev/null
@@ -1 +0,0 @@
-A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0
diff --git a/.jjconflict-side-0/test/dune b/.jjconflict-side-0/test/dune
deleted file mode 100644
index 7e8b7438..00000000
--- a/.jjconflict-side-0/test/dune
+++ /dev/null
@@ -1,9 +0,0 @@
-(test
- (name test)
- (modules test)
- (libraries mte fmt))
-
-(test
- (name test_crypto)
- (modules test_crypto)
- (libraries mte fmt))
diff --git a/.jjconflict-side-0/test/offline_management.sh b/.jjconflict-side-0/test/offline_management.sh
deleted file mode 100755
index 119c46e0..00000000
--- a/.jjconflict-side-0/test/offline_management.sh
+++ /dev/null
@@ -1,58 +0,0 @@
-#!/bin/bash
-
-set -e
-
-a="/tmp/a.json"
-b="/tmp/b.json"
-
-url="http://localhost:3434"
-auditor_pub=$(<"./test/auditor_public_key")
-master_key="./default/master_offline_private_key"
-zero_euro="EUR:0.0"
-
-offline_tool() {
- dune exec offline -- "$@" > /dev/null
-}
-
-offline_tool download --output $a --url $url"/management/keys"
-offline_tool sign \
---master_key $master_key \
---input $a \
---output $b
-offline_tool upload --input $b --url $url"/management/keys"
-echo "[OK] /management/keys"
-
-offline_tool enable-auditor \
---master_key $master_key \
---output $b \
---auditor_url "auditor.example.com" \
---auditor_name "auditor example" \
---auditor_pub $auditor_pub \
---validity_start 0
-offline_tool upload --input $b --url $url"/management/auditors"
-echo "[OK] /management/auditors"
-
-offline_tool wire-fee \
---master_key $master_key \
---output $b \
---wire_method "xxx" \
---fee_start 0 \
---fee_end 99999999 \
---closing_fee $zero_euro \
---wire_fee $zero_euro
-offline_tool upload --input $b --url $url"/management/wire-fee"
-echo "[OK] /management/wire-fee"
-
-offline_tool global-fees \
---master_key $master_key \
---output $b \
---start_date 0 \
---end_date 99999999 \
---history_fee $zero_euro \
---account_fee $zero_euro \
---purse_fee $zero_euro \
---history_expiration 9999999 \
---purse_account_limit 1 \
---purse_timeout 9999999
-offline_tool upload --input $b --url $url"/management/global-fees"
-echo "[OK] /management/global-fees"
diff --git a/.jjconflict-side-0/test/test.ml b/.jjconflict-side-0/test/test.ml
deleted file mode 100644
index 58b19438..00000000
--- a/.jjconflict-side-0/test/test.ml
+++ /dev/null
@@ -1,110 +0,0 @@
-let () = Mirage_crypto_rng_unix.use_default ()
-
-let () =
- let priv = Mirage_crypto_pk.Rsa.generate ~bits:2048 () in
- let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in
- let () =
- let open Crypto.RsaPrivateKey in
- let priv' = priv |> to_octets |> of_octets |> Result.get_ok in
- assert (to_octets priv = to_octets priv')
- in
- let () =
- let open Crypto.RsaPublicKey in
- let pub' = pub |> to_octets |> of_octets |> Result.get_ok in
- assert (to_octets pub = to_octets pub')
- in
- ()
-
-let () =
- let open Api in
- let check jsont s =
- let encode v = encode jsont v |> Result.get_ok in
- let decode v = decode jsont v |> Result.get_ok in
- let ts = decode s in
- let s' = encode ts in
- let ts' = decode s' in
- let s'' = encode ts' in
- assert (String.equal s' s'')
- in
- let check_bad jsont s =
- let decode = decode jsont in
- assert (Result.is_error (decode s))
- in
- check Timestamp.jsont {|{"t_s": 123456780}|};
- check Timestamp.jsont {|{"t_s": "never"}|};
- check_bad Timestamp.jsont {|{"t_s": "123456780"}|};
- check_bad Timestamp.jsont {|{"t_s": "agagou"}|};
-
- (* CS not implemented *)
- check_bad DenominationKey.jsont
- {|{"cipher": "CS", "age_mask": 18, "cs_pub": "ouhagag"}|};
-
- (* TODO test with a valid rsa_pub value *)
- (* TODO handle "rsa pub_of_octets failure" correctly *)
- (* check_bad DenominationKey.jsont
- {|{"cipher": "RSA", "age_mask": 18, "rsa_pub": "agagouh"}|}; *)
- ()
-
-let () =
- let open Amount in
- let v =
- make ~sign:(Some Sign_plus) ~currency:"EUR" ~value:(Int64.of_int 25)
- ~fraction:(Int32.of_int 678)
- |> Result.get_ok
- in
- let s = to_string v in
- let v' = of_string s |> Result.get_ok in
- assert (v = v');
- let r = of_string {|~EUR:4.9|} in
- assert (Result.is_error r);
- let r = of_string {|+EUR:4.99999999999999999999999|} in
- assert (Result.is_error r);
- ()
-
-let () =
- let open Headers_lib.If_none_match in
- let ok_l =
- [
- "*";
- "\"foo\"";
- "W/\"foo\"";
- "\"foo\", \"bar\"";
- " , W/\"x\" , W/\"y\" , \"z\"";
- ", \"one\" , \"two\" , \"three\"";
- "W/\"a\" , ";
- "W/\"a\" , \"b\"";
- ]
- in
- let bad_l =
- [
- "";
- "foo";
- "W/foo";
- "W/\"unterminated";
- "\"foo\", W/";
- "* , \"bar\"";
- "\"a\" \"b\"";
- "W/\"a\" W/\"b\"";
- "\"fo\x7Fo\"";
- " W/\"a\"";
- "W/\"a\" ";
- ]
- in
- let check_ok input = assert (Result.is_ok (parse input)) in
- let check_bad input = assert (Result.is_error (parse input)) in
- List.iter check_ok ok_l;
- List.iter check_bad bad_l;
-
- ()
-
-let () =
- let round_trip s =
- let s' = s |> B32.encode |> B32.decode |> Result.get_ok in
- assert (s = s')
- in
- let s = String.init 0xff Char.chr in
- round_trip s;
- let s_l = List.init 0x0f (fun i -> String.init i Char.chr) in
- List.iter round_trip s_l;
-
- ()
diff --git a/.jjconflict-side-0/test/test_crypto.ml b/.jjconflict-side-0/test/test_crypto.ml
deleted file mode 100644
index 404db053..00000000
--- a/.jjconflict-side-0/test/test_crypto.ml
+++ /dev/null
@@ -1,110 +0,0 @@
-(* Test vectors taken from GNUnet:
- https://git.gnunet.org/gnunet/gnunet/file/src/cli/util/crypto-test-vectors.json.html *)
-
-let encode = B32.encode
-let decode s = B32.decode s |> Result.get_ok
-
-let () =
- (* hash *)
- let input = "91JPRV3F5GG4EKJNDSJQ8" in
- let expected =
- "D0R24RZ1TPASVQ2NY56CT8AJDYZE9ZGDB0GVZ05E9D4YGZQW2RC5YFPQ0Q86EPW836DY7VYQTNFFJT3ZR2K508F4JVS5JNJKYN2MMFR"
- in
- let output =
- input |> decode |> Hash.H64.hash |> Hash.H64.to_octets |> encode
- in
- assert (output = expected);
-
- ()
-
-let () =
- (* eddsa_key_derivation *)
- let pub = "3M9KK1WSNM1RTY5P72HKFA264V4B7MVHVJ08Y90CV06DYHV8XPP0" in
- let priv = "8QC2VNF8443S5KPNKMB4XMV58BTHWAKZ7SVW5WG3KRB37567XS90" in
- let pub' =
- let open Crypto in
- priv
- |> decode
- |> EddsaPrivateKey.of_octets
- |> Result.get_ok
- |> EddsaPrivateKey.pub_of_priv
- |> EddsaPublicKey.to_octets
- |> encode
- in
- assert (pub = pub');
-
- ()
-
-let () =
- (* eddsa_signing *)
- let priv = "5077XJR9AMH4T97ACKFBVBJD0KFENHPV66B2Y1JBSKXBJKNZJ4E0" in
- let pub = "6E2F03JJ8AEDANTTZZ4SBZDFEEZSF8A9DVGTS6VFBCVZQYQ46RRG" in
- let data = "00000300000000000000" in
- let sig_ =
- "XCNJGJ96WPDH60YVMH6C74NGQSGJE3BC1TYMGX6BHY5DMZZZKTB373QTXJ507K5EBSG9YS2EYKHCX3ATRQ6P5MY9MXC4ZB1XSZ2X23G"
- in
- let open Crypto in
- let msg = decode data in
- let eddsa_priv =
- priv |> decode |> EddsaPrivateKey.of_octets |> Result.get_ok
- in
- let sig_' =
- EddsaSignature.sign ~key:eddsa_priv msg
- |> EddsaSignature.to_octets
- |> encode
- in
- assert (sig_ = sig_');
- let eddsa_pub = pub |> decode |> EddsaPublicKey.of_octets |> Result.get_ok in
- let eddsa_sig = sig_ |> decode |> EddsaSignature.of_octets |> Result.get_ok in
- let () =
- EddsaSignature.verify ~key:eddsa_pub eddsa_sig ~msg |> Result.get_ok
- in
-
- ()
-
-let () =
- (* kdf *)
- let salt = "94KPT83PCNS7J83KC5P78Y8" in
- let ikm = "94KPT83MD1JJ0WV5CDS6AX10D5Q70XBM41NPAY90DNGQ8SBJD5GPR" in
- let ctx =
- "94KPT83141HPYVKMCNW78833D1TPWTSC41GPRWVF41NPWVVQDRG62WS04XMPWSKF4WG6JVH0EHM6A82J8S1G"
- in
- let out_len = 64 in
- let out =
- "GTMR4QT05Z9WF5HKVG0WK9RPXGHSMHJNW377G9GJXCA8B0FEKPF4D27RJMSJZYWSQNTBJ5EYVV7ZW18B48Z0JVJJ80RHB706Y96Q358"
- in
-
- let xts = salt |> decode in
- let ikm = ikm |> decode in
- let ctx = ctx |> decode in
- let okm = Crypto.FDH_RSA.Kdf.kdf ~xts ~ikm ~ctx ~len:out_len in
- let okm = okm |> encode in
- assert (okm = out);
-
- ()
-
-let () =
- (* rsa_blind_signing *)
- (* rsa_private_key data is given in gcrypt sexpr format.. *)
- let message_hash =
- "XKQMJ4CNTXBFE1V2WR6JS063J7PZQE4XMB5JH3RS5X0THQ1JQSQ69Y7KDBC9TYRJEZH48MEPY2SF4QHQ4VHXC0YQX5935MQEGP0AX6R"
- in
- let rsa_public_key =
- "040000YRN1NVJ68RS6RJF52PGRCQG19ZKWQPSTJX2G7ZDCKSZFE2VW3HHA81YF5C639JHJF5TX8YTEE2FW2WQCG1PTKNBSPPJEJGA032CN3E8QZ27VWY0K6JFT8ZSYWRH2SKDMXW56A4QKY46JJBWJ6T0ZRVBW6S1HTHXVE2RW8MXRW5T801077MDY13N5F8Z1JZVKBJ06TK3S0YPEDBXK0VEHRHEQJ5X5XYKR4KQTFAZNBMKXY8836VCHBXTK4YNX6AJ1CK29SMJH3Z3QRM16A2TNQGFR0HSMV446BF7FMT2E379ZAT5ST4G3BM2NWZYW545S2SW5MG5S6M88XZZ7SKFD48YVXNZ205GGSEYJPVBMR76WG4ZG30WBCPC1N54XE12RMAG81D8C09WG22PKGGDHYXX68N04002"
- in
- let blinding_key_secret =
- "3SWF49XZPHQMENTSBZQR7Z0B8ZSZ2JRARE79Q4VXZMQ7W6QABXMG"
- in
- let blinded_message =
- "3KHKZJZ30ABB4E56MA2V0EQWGCWH0QQG9P2ZHYHR186C5HZXJMM4N9WXAQTKS94QSV9Y17GGNXN5MB1PZZFG7Q0FY88QPKKRG4MYCPSMTZK5W59R0MJVNJ4P4AQM96TDG5W7RV8GSNR1QQZ1GNHW3CX6D6ZRTMXB2NKB5SSYTDJS79F5ZFBRZ4HVED9JBBPWSR79KVV5QQ4APBGHBCKGMF9NJJS53A1BVYHDEVYAGFYF2SNEP827ZP50FKJ5GKGV8NQ15ESEZ69AT7GJG0T3TZVENY2YN9CVR98W3BKEZ53J7VTANARG8SJS8AMJQ7S23P5HRJ7XE9KTNRNXKH49MXV9JHHYE5535N7AGWEKR47SBCGNF44Z7XJ9RV5BQV12ZRJKN4HBZQHDNCMH3QKX9Z6G64"
- in
- let open Crypto in
- let msg = message_hash |> decode in
- let pub =
- rsa_public_key |> decode |> RsaPublicKey.of_octets |> Result.get_ok
- in
- let bks = blinding_key_secret |> decode in
- let s = FDH_RSA.rsa_blind pub ~bks ~msg |> encode in
- assert (s = blinded_message);
-
- ()
diff --git a/.jjconflict-side-0/tools/dbinit.sh b/.jjconflict-side-0/tools/dbinit.sh
deleted file mode 100755
index 4d74bc9a..00000000
--- a/.jjconflict-side-0/tools/dbinit.sh
+++ /dev/null
@@ -1,100 +0,0 @@
-#!/bin/bash
-
-# TODO
-# use specific commit
-
-# usage:
-# `create_database`
-# create a `taler-exchange` database
-# `fetch`
-# fetch all *.sql and *.sql.in files from GNU Taler exchange repository (latest commit)
-# `init`
-# initialize taler-exchange database (create tables, ...)
-# `taler-exchange` database must already be created
-#
-
-
-set -e
-
-taler_repo_url="https://git-www.taler.net/exchange.git/"
-
-tmp_dir="/tmp/taler_exchange"
-out_dir="./_taler_exchange_sql"
-init_sql="${out_dir}/init.sql"
-drop_sql="${out_dir}/drop.sql"
-
-# psql parameter
-host="localhost"
-port=5432
-username="mte"
-dbname="taler-exchange"
-
-fetch() {
- git clone --depth 1 $taler_repo_url $tmp_dir
-}
-
-process() {
- source_dir="${tmp_dir}/src/exchangedb"
- sql_in_files=(
- "procedures.sql"
- "exchange-0002.sql"
- "exchange-0003.sql"
- "exchange-0004.sql"
- )
- for file in "${sql_in_files[@]}"; do
- file_in="${source_dir}/${file}.in"
- file_out="${source_dir}/${file}"
- gcc -E -P -undef -I "$source_dir" - < "$file_in" \
- 2>/dev/null \
- > "$file_out"
- done
- # order is important
- files=(
- "versioning.sql"
- "exchange-0001.sql"
- "exchange-0002.sql"
- "exchange-0003.sql"
- "exchange-0004.sql"
- "exchange-0005.sql"
- "procedures.sql"
- )
- mkdir -p "$out_dir"
- cat "${source_dir}/drop.sql" > "$drop_sql"
- echo "" > "$init_sql"
- for file in "${files[@]}"; do
- cat "${source_dir}/${file}" >> "$init_sql"
- done
-}
-
-# ? "NOTICE: function xxx() does not exist, skipping"
-init() {
- psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$init_sql
-}
-
-drop_schema() {
- psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$drop_sql
-}
-
-create_database() {
- createdb --host=$host --port=$port --username=$username --password $dbname
-}
-
-drop_database() {
- dropdb --host=$host --port=$port --username=$username --password $dbname
-}
-
-if [[ $# -eq 0 ]]; then
- echo "no argument" >&2
- exit 1
-fi
-
-cmd=$1
-case "$cmd" in
- fetch) fetch "$@"; exit 0;;
- process) process "$@"; exit 0;;
- init) init "$@"; exit 0;;
- drop_schema) drop_schema "$@"; exit 0;;
- create_database) create_database "$@"; exit 0;;
- drop_database) drop_database "$@"; exit 0;;
- *) echo "Unknown command: $cmd" >&2; exit 1;;
-esac
diff --git a/.jjconflict-side-0/tools/dune b/.jjconflict-side-0/tools/dune
deleted file mode 100644
index 7b747b57..00000000
--- a/.jjconflict-side-0/tools/dune
+++ /dev/null
@@ -1,16 +0,0 @@
-(executable
- (public_name offline)
- (name offline)
- (modules offline offline_impl)
- (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
-
-(executable
- (public_name gen_registry_files)
- (name gen_registry_files)
- (modules gen_registry_files)
- (libraries recfile_parser bos fmt))
-
-(library
- (name recfile_parser)
- (modules recfile_parser)
- (libraries angstrom bos cmdliner fmt))
diff --git a/.jjconflict-side-0/tools/gen_registry_files.ml b/.jjconflict-side-0/tools/gen_registry_files.ml
deleted file mode 100644
index ebaae034..00000000
--- a/.jjconflict-side-0/tools/gen_registry_files.ml
+++ /dev/null
@@ -1,89 +0,0 @@
-module Signature_code = struct
- type t = {
- number: int32;
- name: string;
- comment: string;
- }
-end
-
-let parse_signature_codes records =
- records
- |> List.filter_map (fun l ->
- match l with
- | a :: b :: c :: _ -> (
- let open Recfile_parser in
- match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
- | false -> None
- | true ->
- Some
- Signature_code.
- {
- number= Int32.of_int (int_of_string a.v);
- name= String.lowercase_ascii b.v;
- comment= c.v;
- })
- | _ -> None)
- |> List.filter (fun v -> v.Signature_code.number >= 1000_l)
-
-let pp_taler_signatures_ml ppf purposes =
- let header =
- {|(* This file was generated from the GANA database:
- https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|}
- in
- let pp ppf Signature_code.{ number; name; comment } =
- Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
- in
- Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
- ()
-
-let download ~tmp ~url =
- let open Bos in
- let res =
- OS.Cmd.run
- Cmd.(
- v "curl" % "--silent" % "--show-error" % "-o" % tmp % "-X" % "GET" % url)
- in
- match res with
- | Error (`Msg s) -> Fmt.failwith "download failure: %s" s
- | Ok () -> ()
-
-let signatures ~output =
- let url =
- "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
- in
- let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
- download ~tmp:(Fpath.to_string tmp_file) ~url;
- let content = Bos.OS.File.read tmp_file |> Result.get_ok in
- match Recfile_parser.parse content with
- | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
- | Ok records ->
- let purposes = parse_signature_codes records in
- let module_content = Fmt.str "%a" pp_taler_signatures_ml purposes in
- Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok
-
-(* --- *)
-open Cmdliner
-open Cmdliner.Term.Syntax
-
-let output =
- let doc = "output file" in
- Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
-
-let signatures_cmd =
- let doc =
- "Generate taler_signatures.ml from GANA gnunet-signatures registry"
- in
- Cmd.make (Cmd.info "signatures" ~doc)
- @@
- let+ output = output in
- signatures ~output
-
-let cli =
- let info =
- let doc = "Tool to generate OCaml module from GANA registries" in
- Cmd.info "gen_registry_files" ~doc
- in
- Cmd.group info [ signatures_cmd ]
-
-let main () = Cmd.eval cli
-let () = if !Sys.interactive then () else exit (main ())
diff --git a/.jjconflict-side-0/tools/offline.ml b/.jjconflict-side-0/tools/offline.ml
deleted file mode 100644
index 461492c7..00000000
--- a/.jjconflict-side-0/tools/offline.ml
+++ /dev/null
@@ -1,310 +0,0 @@
-(* TODO
- all management operations:
- /management/wire
- /management/wire/disable
-
- /management/aml-officers
- -> /aml
- /management/partners
- -> /wads *)
-
-open Cmdliner
-open Cmdliner.Term.Syntax
-open Offline_impl
-
-module Arg = struct
- include Arg
-
- (* in seconds *)
- let timestamp =
- let parser s =
- match int_of_string_opt s with
- | None -> Error "not an int"
- | Some n -> Ok (Time.Timestamp.of_s (Int64.of_int n))
- in
- let pp fmt t =
- match Time.Timestamp.to_s t with
- | None -> Fmt.pf fmt "never"
- | Some s -> Fmt.pf fmt "%Ld" s
- in
- Arg.Conv.make ~docv:"timestamp argument" ~parser ~pp ()
-
- (* in seconds *)
- let relative_time =
- let parser s =
- match int_of_string_opt s with
- | None -> Error "not an int"
- | Some s -> Ok (Time.Relative.of_s (Int64.of_int s))
- in
- let pp fmt d =
- let t = Time.Timestamp.of_absolute Time.Absolute.(add zero d) in
- match Time.Timestamp.to_s t with
- | None -> Fmt.pf fmt "never"
- | Some s -> Fmt.pf fmt "%Ld" s
- in
- Arg.Conv.make ~docv:"relative time argument" ~parser ~pp ()
-
- let b32 =
- let pp fmt v = Fmt.pf fmt "%s" (B32.encode v) in
- Arg.Conv.make ~docv:"Crockford's Base32 encoded argument" ~parser:B32.decode
- ~pp ()
-
- let amount =
- Arg.Conv.make ~docv:"amount argument" ~parser:Amount.of_string ~pp:Amount.pp
- ()
-
- let eddsa_pub =
- let parser s = Crypto.EddsaPublicKey.of_b32 s in
- let pp fmt key =
- let s = Crypto.EddsaPublicKey.to_b32 key in
- Fmt.pf fmt "%s" s
- in
- Arg.Conv.make ~docv:"eddsa public key argument" ~parser ~pp ()
-end
-
-let master_key =
- let doc = "Master offline Eddsa private key file." in
- Arg.(required & opt (some file) None & info [ "master_key" ] ~doc)
-
-let input =
- let doc = "input file" in
- Arg.(required & opt (some file) None & info [ "i"; "input" ] ~doc)
-
-let output =
- let doc = "output file" in
- Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
-
-let url =
- let doc = "url" in
- Arg.(required & opt (some string) None & info [ "url" ] ~doc)
-
-let setup_cmd =
- let doc =
- "Generate offline master keys, write private and public key to file"
- in
- let output =
- let doc = "private key output file" in
- Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
- in
- let output_pubkey =
- let doc =
- "public key output file, default to --output parameter with a \".pub\" \
- extension"
- in
- Arg.(value & opt (some filepath) None & info [ "output-pubkey" ] ~doc)
- in
- Cmd.make (Cmd.info "setup" ~doc)
- @@
- let+ output = output and+ output_pubkey = output_pubkey in
- let output_pubkey = Option.value ~default:(output ^ ".pub") output_pubkey in
- setup ~output ~output_pubkey
-
-let download_cmd =
- let doc =
- "use curl to send a GET request to --url, write response body to --output"
- in
- Cmd.make (Cmd.info "download" ~doc)
- @@
- let+ output = output and+ url = url in
- download ~output ~url
-
-let upload_cmd =
- let doc =
- "use curl to send a POST request to --url, with request body set to \
- --input file content"
- in
- Cmd.make (Cmd.info "upload" ~doc)
- @@
- let+ input = input and+ url = url in
- upload ~input ~url
-
-let sign_cmd =
- let doc = "Sign FutureKeysResponse." in
- Cmd.make (Cmd.info "sign" ~doc)
- @@
- let+ input = input and+ output = output and+ master_key = master_key in
- sign ~input ~output ~master_key
-
-let revoke_denom_cmd =
- let doc = "Revoke denomination." in
- let h_denom =
- let doc = "hash of denomination public key" in
- Arg.(required & pos 0 (some string) None & info [] ~doc)
- in
- Cmd.make (Cmd.info "revoke-denom" ~doc)
- @@
- let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
- revoke_denom ~output ~master_key ~h_denom
-
-let revoke_signkey_cmd =
- let doc = "Revoke signkey." in
- let signkey =
- let doc = "public signing key" in
- Arg.(required & pos 0 (some eddsa_pub) None & info [] ~doc)
- in
- Cmd.make (Cmd.info "revoke-signkey" ~doc)
- @@
- let+ output = output and+ master_key = master_key and+ signkey = signkey in
- revoke_signkey ~output ~master_key ~signkey
-
-let enable_auditor_cmd =
- let doc = "Enable auditor." in
- let auditor_url =
- Arg.(required & opt (some string) None & info [ "auditor_url" ])
- in
- let auditor_name =
- Arg.(required & opt (some string) None & info [ "auditor_name" ])
- in
- let auditor_pub =
- Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
- in
- let validity_start =
- Arg.(required & opt (some timestamp) None & info [ "validity_start" ])
- in
- Cmd.make (Cmd.info "enable-auditor" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ auditor_url = auditor_url
- and+ auditor_name = auditor_name
- and+ auditor_pub = auditor_pub
- and+ validity_start = validity_start in
- enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
- ~validity_start
-
-let disable_auditor_cmd =
- let doc = "Disable auditor." in
- let auditor_pub =
- Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
- in
- let validity_end =
- Arg.(required & opt (some timestamp) None & info [ "validity_end" ])
- in
- Cmd.make (Cmd.info "disable-auditor" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ auditor_pub = auditor_pub
- and+ validity_end = validity_end in
- disable_auditor ~output ~master_key ~auditor_pub ~validity_end
-
-let wire_fee_cmd =
- let doc = "Provides wire fee configuration." in
- let wire_method =
- Arg.(required & opt (some string) None & info [ "wire_method" ])
- in
- let fee_start =
- Arg.(required & opt (some timestamp) None & info [ "fee_start" ])
- in
- let fee_end =
- Arg.(required & opt (some timestamp) None & info [ "fee_end" ])
- in
- let closing_fee =
- Arg.(required & opt (some amount) None & info [ "closing_fee" ])
- in
- let wire_fee =
- Arg.(required & opt (some amount) None & info [ "wire_fee" ])
- in
- Cmd.make (Cmd.info "wire-fee" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ wire_method = wire_method
- and+ fee_start = fee_start
- and+ fee_end = fee_end
- and+ closing_fee = closing_fee
- and+ wire_fee = wire_fee in
- Offline_impl.wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end
- ~closing_fee ~wire_fee
-
-let global_fees_cmd =
- let doc = "Provides global fee configuration." in
- let start_date =
- Arg.(required & opt (some timestamp) None & info [ "start_date" ])
- in
- let end_date =
- Arg.(required & opt (some timestamp) None & info [ "end_date" ])
- in
- let history_fee =
- Arg.(required & opt (some amount) None & info [ "history_fee" ])
- in
- let account_fee =
- Arg.(required & opt (some amount) None & info [ "account_fee" ])
- in
- let purse_fee =
- Arg.(required & opt (some amount) None & info [ "purse_fee" ])
- in
- let history_expiration =
- Arg.(
- required & opt (some relative_time) None & info [ "history_expiration" ])
- in
- let purse_account_limit =
- Arg.(required & opt (some int) None & info [ "purse_account_limit" ])
- in
- let purse_timeout =
- Arg.(required & opt (some relative_time) None & info [ "purse_timeout" ])
- in
- Cmd.make (Cmd.info "global-fees" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ start_date = start_date
- and+ end_date = end_date
- and+ history_fee = history_fee
- and+ account_fee = account_fee
- and+ purse_fee = purse_fee
- and+ history_expiration = history_expiration
- and+ purse_account_limit = purse_account_limit
- and+ purse_timeout = purse_timeout in
- global_fees ~output ~master_key ~start_date ~end_date ~history_fee
- ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
- ~purse_timeout
-
-let drain_cmd =
- let doc =
- "Drain profits from the exchange. The actual drain requires running the \
- `taler-exchange-drain` tool."
- in
- let debit_account_section =
- Arg.(required & opt (some string) None & info [ "debit_account_section" ])
- in
- let credit_payto_uri =
- Arg.(required & opt (some string) None & info [ "credit_payto_uri" ])
- in
- let wtid = Arg.(required & opt (some b32) None & info [ "wtid" ]) in
- let date = Arg.(required & opt (some timestamp) None & info [ "date" ]) in
- let amount = Arg.(required & opt (some amount) None & info [ "amount" ]) in
- Cmd.make (Cmd.info "drain" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ debit_account_section = debit_account_section
- and+ credit_payto_uri = credit_payto_uri
- and+ wtid = wtid
- and+ date = date
- and+ amount = amount in
- drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid ~date
- ~amount
-
-let cli =
- let info =
- let doc = "MTE Offline CLI tool" in
- Cmd.info "mte-offline" ~doc
- in
- Cmd.group info
- [
- setup_cmd;
- download_cmd;
- sign_cmd;
- upload_cmd;
- revoke_denom_cmd;
- revoke_signkey_cmd;
- enable_auditor_cmd;
- disable_auditor_cmd;
- wire_fee_cmd;
- global_fees_cmd;
- drain_cmd;
- ]
-
-let main () = Cmd.eval_result cli
-let () = if !Sys.interactive then () else exit (main ())
diff --git a/.jjconflict-side-0/tools/offline_impl.ml b/.jjconflict-side-0/tools/offline_impl.ml
deleted file mode 100644
index 9a851fa5..00000000
--- a/.jjconflict-side-0/tools/offline_impl.ml
+++ /dev/null
@@ -1,378 +0,0 @@
-open Syntax
-open Hash
-
-module Future_keys = struct
- open Crypto
- open Api
-
- let verify =
- let verify_future_denom ~sm_denom_pub
- 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 h_denom_pub =
- DenominationHash.hash (DenominationKey.to_octets denom_pub)
- in
- let h_section_name = Hash.Cstring.H64.hash section_name in
- let anchor_time = stamp_start in
- let duration_withdraw =
- Timestamp.diff stamp_start stamp_expire_withdraw
- in
- let open Signatures.DenominationKeyAnnouncement in
- verify_f
- ~f:(EddsaSignature.verify ~key:sm_denom_pub)
- denom_secmod_sig
- { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
- in
- let verify_future_signkey ~sm_signkey_pub
- FutureSignKey.
- { key; stamp_start; stamp_expire; stamp_end= _; signkey_secmod_sig } =
- let exchange_pub = key in
- let anchor_time = stamp_start in
- let duration = Timestamp.diff stamp_start stamp_expire in
- let open Signatures.SigningKeyAnnouncement in
- verify_f
- ~f:(EddsaSignature.verify ~key:sm_signkey_pub)
- signkey_secmod_sig
- { exchange_pub; anchor_time; duration }
- in
- fun our_master_public_key
- FutureKeysResponse.
- {
- future_denoms;
- future_signkeys;
- master_pub;
- denom_secmod_public_key;
- signkey_secmod_public_key;
- }
- ->
- let* () =
- match master_pub = our_master_public_key with
- | false ->
- Fmt.error
- "master public key of the future key response does not match ours"
- | true -> Ok ()
- in
- let* () =
- list_iter
- (verify_future_denom ~sm_denom_pub:denom_secmod_public_key)
- future_denoms
- in
- let* () =
- list_iter
- (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key)
- future_signkeys
- in
- Ok ()
-
- let make =
- let denom_signature ~master_key
- 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 octets = DenominationKey.to_octets denom_pub in
- let h_denom_pub = DenominationHash.hash octets in
- let master_sig =
- let open Signatures.DenominationKeyValidity in
- let master = EddsaPrivateKey.(pub_of_priv master_key) in
- sign_f
- ~f:(EddsaSignature.sign ~key:master_key)
- {
- master;
- start= stamp_start;
- expire_withdraw= stamp_expire_withdraw;
- expire_spend= stamp_expire_deposit;
- expire_legal= stamp_expire_legal;
- value;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- denom_hash= h_denom_pub;
- }
- in
- DenomSignature.{ h_denom_pub; master_sig }
- in
- let signkey_signature ~master_key
- FutureSignKey.
- { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
- let master_sig =
- let open Signatures.ExchangeSigningKeyValidity in
- sign_f
- ~f:(EddsaSignature.sign ~key:master_key)
- {
- start= stamp_start;
- expire= stamp_expire;
- end_= stamp_end;
- signkey_pub= key;
- }
- in
- SignKeySignature.{ key; master_sig }
- in
- fun ~master_key
- FutureKeysResponse.
- {
- future_denoms;
- future_signkeys;
- master_pub= _;
- denom_secmod_public_key= _;
- signkey_secmod_public_key= _;
- }
- ->
- let denom_sigs = List.map (denom_signature ~master_key) future_denoms in
- let signkey_sigs =
- List.map (signkey_signature ~master_key) future_signkeys
- in
- MasterSignatures.{ denom_sigs; signkey_sigs }
-end
-
-(* -- *)
-
-let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_err_msg
-
-let write_file fname content =
- Bos.OS.File.write (Fpath.v fname) content |> unwrap_err_msg
-
-let read_master_key_file filename =
- let* master_key = read_file filename in
- Crypto.EddsaPrivateKey.of_octets master_key
-
-let download ~output ~url =
- let open Bos in
- OS.Cmd.run
- Cmd.(
- v "curl"
- % "--silent"
- % "--show-error"
- % "-o"
- % output
- % "-X"
- % "GET"
- % url)
- |> unwrap_err_msg
-
-let upload ~input ~url =
- let open Bos in
- OS.Cmd.run
- Cmd.(
- v "curl"
- % "--silent"
- % "-i"
- % "-X"
- % "POST"
- % "-H"
- % "Content-Type: application/json"
- % "--data"
- % ("@" ^ input)
- % url)
- |> unwrap_err_msg
-
-let setup ~output ~output_pubkey =
- Mirage_crypto_rng_unix.use_default ();
- let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
- let priv_data = Mirage_crypto_ec.Ed25519.priv_to_octets priv in
- let* () = write_file output priv_data in
- let pub_data = Mirage_crypto_ec.Ed25519.pub_to_octets pub |> B32.encode in
- let* () = write_file output_pubkey pub_data in
- Ok ()
-
-let sign ~master_key ~input ~output =
- let open Crypto in
- let* master_key = read_master_key_file master_key in
- let* input = read_file input in
- let master_pub = EddsaPrivateKey.pub_of_priv master_key in
- let* future_keys_response = Api.decode Api.FutureKeysResponse.jsont input in
- let* () = Future_keys.verify master_pub future_keys_response in
- let master_signatures = Future_keys.make ~master_key future_keys_response in
- let* s = Api.encode Api.MasterSignatures.jsont master_signatures in
- let* () = write_file output s in
- Ok ()
-
-let revoke_denom ~output ~master_key ~h_denom =
- let* key = read_master_key_file master_key in
- let* h_denom_pub = DenominationHash.of_b32 h_denom in
- let denom_revoke =
- let master_sig =
- let open Signatures.MasterDenominationKeyRevocation in
- sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub }
- in
- Api.DenomRevocationSignature.{ master_sig }
- in
- let* s = Api.encode Api.DenomRevocationSignature.jsont denom_revoke in
- let* () = write_file output s in
- Ok ()
-
-let revoke_signkey ~output ~master_key ~signkey =
- let* key = read_master_key_file master_key in
- let signkey_revoke =
- let master_sig =
- let open Signatures.MasterSigningKeyRevocation in
- sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey }
- in
- Api.SignkeyRevocationSignature.{ master_sig }
- in
- let* s = Api.encode Api.SignkeyRevocationSignature.jsont signkey_revoke in
- let* () = write_file output s in
- Ok ()
-
-let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
- ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
- ~purse_timeout =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let* purse_account_limit =
- match
- purse_account_limit >= 0
- && purse_account_limit <= Int32.to_int Int32.max_int
- with
- | false -> Error "invalid purse_account_limit value"
- | true -> Ok (Int32.of_int purse_account_limit)
- in
- let master_sig =
- let open Signatures.GlobalFees in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- }
- in
- let global_fees =
- Api.GlobalFees.
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- master_sig;
- }
- in
- let* s = Api.encode Api.GlobalFees.jsont global_fees in
- let* () = write_file output s in
- Ok ()
-
-let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
- ~validity_start =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig =
- let open Signatures.MasterAddAuditor in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- start_date= validity_start;
- auditor_pub;
- h_auditor_url= Hash.Cstring.H64.hash auditor_url;
- }
- in
- let v =
- Api.AuditorSetupMessage.
- { auditor_url; auditor_name; auditor_pub; master_sig; validity_start }
- in
- let* s = Api.encode Api.AuditorSetupMessage.jsont v in
- let* () = write_file output s in
- Ok ()
-
-let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig =
- let open Signatures.MasterDelAuditor in
- sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
- in
- let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in
- let* s = Api.encode Api.AuditorTeardownMessage.jsont v in
- let* () = write_file output s in
- Ok ()
-
-let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
- ~wire_fee =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig_wire =
- let open Signatures.MasterWireFee in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- h_wire_method= Hash.Cstring.H64.hash wire_method;
- start_date= fee_start;
- end_date= fee_end;
- closing_fee;
- wire_fee;
- }
- in
- let v =
- Api.WireFeeSetupMessage.
- {
- wire_method;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- master_sig_wire;
- }
- in
- let* s = Api.encode Api.WireFeeSetupMessage.jsont v in
- let* () = write_file output s in
- Ok ()
-
-let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid
- ~date ~amount =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig =
- let open Signatures.MasterDrainProfit in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- wtid;
- date;
- amount;
- h_section= Hash.Cstring.H64.hash debit_account_section;
- h_payto= FullPaytoHash.hash credit_payto_uri;
- }
- in
- let v =
- Api.DrainProfitsMessage.
- {
- debit_account_section;
- credit_payto_uri;
- wtid;
- master_sig;
- date;
- amount;
- }
- in
- let* s = Api.encode Api.DrainProfitsMessage.jsont v in
- let* () = write_file output s in
- Ok ()
diff --git a/.jjconflict-side-0/tools/recfile_parser.ml b/.jjconflict-side-0/tools/recfile_parser.ml
deleted file mode 100644
index 94882a2f..00000000
--- a/.jjconflict-side-0/tools/recfile_parser.ml
+++ /dev/null
@@ -1,51 +0,0 @@
-(* very rudimentary recfile parser
- https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
-
-open Angstrom
-
-type field = {
- k: string;
- v: string;
-}
-
-type record = field list
-
-let newline = char '\n'
-let is_newline = function '\n' -> true | _ -> false
-
-let field_name =
- let first_char =
- satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
- in
- let subsequent_char =
- satisfy (function
- | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
- | _ -> false)
- in
- lift2
- (fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
- first_char (many subsequent_char)
-
-(* todo handle '\' escape and '+' on next line *)
-let field_value = take_till is_newline <* newline
-
-let field =
- let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
- let blanks = skip_many1 blank in
- lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
-
-let blank = newline *> return ()
-let comment = (char '#' *> take_till is_newline <* newline) *> return ()
-let record = many1 field
-
-let records =
- let sep =
- (* at least one blank line *)
- skip_many comment *> blank *> skip_many (comment <|> blank)
- in
- sep_by1 sep record
-
-let recfile : record list t =
- skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
-
-let parse s = parse_string ~consume:All recfile s
diff --git a/.jjconflict-side-1/.gitignore b/.jjconflict-side-1/.gitignore
deleted file mode 100644
index 7aeab444..00000000
--- a/.jjconflict-side-1/.gitignore
+++ /dev/null
@@ -1,5 +0,0 @@
-_build
-_taler_exchange_sql
-assets
-secrets
-!secrets/.keep
diff --git a/.jjconflict-side-1/.ocamlformat b/.jjconflict-side-1/.ocamlformat
deleted file mode 100644
index 43b12fc0..00000000
--- a/.jjconflict-side-1/.ocamlformat
+++ /dev/null
@@ -1,15 +0,0 @@
-version=0.28.1
-exp-grouping=preserve
-type-decl=sparse
-break-infix=fit-or-vertical
-break-collection-expressions=fit-or-vertical
-break-sequences=false
-break-infix-before-func=false
-dock-collection-brackets=true
-break-separators=after
-field-space=tight
-if-then-else=compact
-break-sequences=false
-sequence-blank-line=compact
-exp-grouping=preserve
-sequence-blank-line=preserve-one
diff --git a/.jjconflict-side-1/LICENSE b/.jjconflict-side-1/LICENSE
deleted file mode 100644
index be3f7b28..00000000
--- a/.jjconflict-side-1/LICENSE
+++ /dev/null
@@ -1,661 +0,0 @@
- GNU AFFERO GENERAL PUBLIC LICENSE
- Version 3, 19 November 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc.
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The GNU Affero General Public License is a free, copyleft license for
-software and other kinds of works, specifically designed to ensure
-cooperation with the community in the case of network server software.
-
- The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works. By contrast,
-our General Public Licenses are intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
- Developers that use our General Public Licenses protect your rights
-with two steps: (1) assert copyright on the software, and (2) offer
-you this License which gives you legal permission to copy, distribute
-and/or modify the software.
-
- A secondary benefit of defending all users' freedom is that
-improvements made in alternate versions of the program, if they
-receive widespread use, become available for other developers to
-incorporate. Many developers of free software are heartened and
-encouraged by the resulting cooperation. However, in the case of
-software used on network servers, this result may fail to come about.
-The GNU General Public License permits making a modified version and
-letting the public access it on a server without ever releasing its
-source code to the public.
-
- The GNU Affero General Public License is designed specifically to
-ensure that, in such cases, the modified source code becomes available
-to the community. It requires the operator of a network server to
-provide the source code of the modified version running there to the
-users of that server. Therefore, public use of a modified version, on
-a publicly accessible server, gives the public access to the source
-code of the modified version.
-
- An older license, called the Affero General Public License and
-published by Affero, was designed to accomplish similar goals. This is
-a different license, not a version of the Affero GPL, but Affero has
-released a new version of the Affero GPL which permits relicensing under
-this license.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- TERMS AND CONDITIONS
-
- 0. Definitions.
-
- "This License" refers to version 3 of the GNU Affero General Public License.
-
- "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
- "The Program" refers to any copyrightable work licensed under this
-License. Each licensee is addressed as "you". "Licensees" and
-"recipients" may be individuals or organizations.
-
- To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy. The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
- A "covered work" means either the unmodified Program or a work based
-on the Program.
-
- To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy. Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
- To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies. Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
- An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License. If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
- 1. Source Code.
-
- The "source code" for a work means the preferred form of the work
-for making modifications to it. "Object code" means any non-source
-form of a work.
-
- A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
- The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form. A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
- The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities. However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work. For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
- The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
- The Corresponding Source for a work in source code form is that
-same work.
-
- 2. Basic Permissions.
-
- All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met. This License explicitly affirms your unlimited
-permission to run the unmodified Program. The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work. This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
- You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force. You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright. Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
- Conveying under any other circumstances is permitted solely under
-the conditions stated below. Sublicensing is not allowed; section 10
-makes it unnecessary.
-
- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
- No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
- When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
- 4. Conveying Verbatim Copies.
-
- You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
- You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
- 5. Conveying Modified Source Versions.
-
- You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
- a) The work must carry prominent notices stating that you modified
- it, and giving a relevant date.
-
- b) The work must carry prominent notices stating that it is
- released under this License and any conditions added under section
- 7. This requirement modifies the requirement in section 4 to
- "keep intact all notices".
-
- c) You must license the entire work, as a whole, under this
- License to anyone who comes into possession of a copy. This
- License will therefore apply, along with any applicable section 7
- additional terms, to the whole of the work, and all its parts,
- regardless of how they are packaged. This License gives no
- permission to license the work in any other way, but it does not
- invalidate such permission if you have separately received it.
-
- d) If the work has interactive user interfaces, each must display
- Appropriate Legal Notices; however, if the Program has interactive
- interfaces that do not display Appropriate Legal Notices, your
- work need not make them do so.
-
- A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit. Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
- 6. Conveying Non-Source Forms.
-
- You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
- a) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by the
- Corresponding Source fixed on a durable physical medium
- customarily used for software interchange.
-
- b) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by a
- written offer, valid for at least three years and valid for as
- long as you offer spare parts or customer support for that product
- model, to give anyone who possesses the object code either (1) a
- copy of the Corresponding Source for all the software in the
- product that is covered by this License, on a durable physical
- medium customarily used for software interchange, for a price no
- more than your reasonable cost of physically performing this
- conveying of source, or (2) access to copy the
- Corresponding Source from a network server at no charge.
-
- c) Convey individual copies of the object code with a copy of the
- written offer to provide the Corresponding Source. This
- alternative is allowed only occasionally and noncommercially, and
- only if you received the object code with such an offer, in accord
- with subsection 6b.
-
- d) Convey the object code by offering access from a designated
- place (gratis or for a charge), and offer equivalent access to the
- Corresponding Source in the same way through the same place at no
- further charge. You need not require recipients to copy the
- Corresponding Source along with the object code. If the place to
- copy the object code is a network server, the Corresponding Source
- may be on a different server (operated by you or a third party)
- that supports equivalent copying facilities, provided you maintain
- clear directions next to the object code saying where to find the
- Corresponding Source. Regardless of what server hosts the
- Corresponding Source, you remain obligated to ensure that it is
- available for as long as needed to satisfy these requirements.
-
- e) Convey the object code using peer-to-peer transmission, provided
- you inform other peers where the object code and Corresponding
- Source of the work are being offered to the general public at no
- charge under subsection 6d.
-
- A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
- A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling. In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage. For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product. A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
- "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source. The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
- If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information. But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
- The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed. Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
- Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
- 7. Additional Terms.
-
- "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law. If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
- When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it. (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.) You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
- Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
- a) Disclaiming warranty or limiting liability differently from the
- terms of sections 15 and 16 of this License; or
-
- b) Requiring preservation of specified reasonable legal notices or
- author attributions in that material or in the Appropriate Legal
- Notices displayed by works containing it; or
-
- c) Prohibiting misrepresentation of the origin of that material, or
- requiring that modified versions of such material be marked in
- reasonable ways as different from the original version; or
-
- d) Limiting the use for publicity purposes of names of licensors or
- authors of the material; or
-
- e) Declining to grant rights under trademark law for use of some
- trade names, trademarks, or service marks; or
-
- f) Requiring indemnification of licensors and authors of that
- material by anyone who conveys the material (or modified versions of
- it) with contractual assumptions of liability to the recipient, for
- any liability that these contractual assumptions directly impose on
- those licensors and authors.
-
- All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10. If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term. If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
- If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
- Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
- 8. Termination.
-
- You may not propagate or modify a covered work except as expressly
-provided under this License. Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
- However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
- Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
- Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
- 9. Acceptance Not Required for Having Copies.
-
- You are not required to accept this License in order to receive or
-run a copy of the Program. Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance. However,
-nothing other than this License grants you permission to propagate or
-modify any covered work. These actions infringe copyright if you do
-not accept this License. Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
- 10. Automatic Licensing of Downstream Recipients.
-
- Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License. You are not responsible
-for enforcing compliance by third parties with this License.
-
- An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations. If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
- You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License. For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
- 11. Patents.
-
- A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based. The
-work thus licensed is called the contributor's "contributor version".
-
- A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version. For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
- Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
- In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement). To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
- If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients. "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
- If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
- A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License. You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
- Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
- 12. No Surrender of Others' Freedom.
-
- If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all. For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
- 13. Remote Network Interaction; Use with the GNU General Public License.
-
- Notwithstanding any other provision of this License, if you modify the
-Program, your modified version must prominently offer all users
-interacting with it remotely through a computer network (if your version
-supports such interaction) an opportunity to receive the Corresponding
-Source of your version by providing access to the Corresponding Source
-from a network server at no charge, through some standard or customary
-means of facilitating copying of software. This Corresponding Source
-shall include the Corresponding Source for any work covered by version 3
-of the GNU General Public License that is incorporated pursuant to the
-following paragraph.
-
- Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU General Public License into a single
-combined work, and to convey the resulting work. The terms of this
-License will continue to apply to the part which is the covered work,
-but the work with which it is combined will remain governed by version
-3 of the GNU General Public License.
-
- 14. Revised Versions of this License.
-
- The Free Software Foundation may publish revised and/or new versions of
-the GNU Affero General Public License from time to time. Such new versions
-will be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Program specifies that a certain numbered version of the GNU Affero General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation. If the Program does not specify a version number of the
-GNU Affero General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
- If the Program specifies that a proxy can decide which future
-versions of the GNU Affero General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
- Later license versions may give you additional or different
-permissions. However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
- 15. Disclaimer of Warranty.
-
- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. Limitation of Liability.
-
- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
- 17. Interpretation of Sections 15 and 16.
-
- If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-
- Copyright (C)
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU Affero General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Affero General Public License for more details.
-
- You should have received a copy of the GNU Affero General Public License
- along with this program. If not, see .
-
-Also add information on how to contact you by electronic and paper mail.
-
- If your software can interact with users remotely through a computer
-network, you should also make sure that it provides a way for users to
-get its source. For example, if your program is a web application, its
-interface could display a "Source" link that leads users to an archive
-of the code. There are many ways you could offer source, and different
-solutions will be better for different programs; see section 13 for the
-specific requirements.
-
- You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU AGPL, see
-.
diff --git a/.jjconflict-side-1/default/assets/mte.conf b/.jjconflict-side-1/default/assets/mte.conf
deleted file mode 100644
index a6c89c52..00000000
--- a/.jjconflict-side-1/default/assets/mte.conf
+++ /dev/null
@@ -1,74 +0,0 @@
-[currency-EUR]
-enabled= YES
-code= EUR
-name= euro
-fractional_input_digits= 2
-fractional_normal_digits= 2
-fractional_trailing_zero_digits= 2
-alt_unit_names= "{"0":"€","3":"k€"}"
-
-[exchange]
-currency = EUR
-currency_round_unit = EUR:0.01
-db = postgres
-attribute_encryption_key = "deadbeef"
-port = 3434
-bind_to = localhost
-master_public_key = "SJ0NYND22VQP3MP7FM754RDX8HCKVWAXTHY9SQNBTPRJZ2SPM2S0"
-stefan_abs = EUR:0.00
-stefan_log = EUR:0.00
-stefan_lin = 0.00
-aggregator_idle_sleep_interval = "1 hour"
-closer_idle_sleep_interval = "1 hour"
-transfer_idle_sleep_interval = "1 hour"
-wirewatch_idle_sleep_interval = "1 hour"
-signkey_legal_duration = "1 year"
-max_keys_caching = "4 weeks"
-enable_kyc = NO
-terms_etag = "0"
-privacy_etag = "0"
-base_url = "http://localhost:3434/"
-
-[exchangedb]
-idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds"
-legal_reserve_expiration_time = "1 year"
-aggregator_shift = "1 year"
-max_aml_program_runtime = "1 year"
-default_purse_limit = 9999
-
-[exchangedb-postgres]
-config = "pgx://mte:hunter2@localhost:5432/taler-exchange"
-
-[taler-exchange-secmod-rsa]
-lookahead_sign = "1 year"
-overlap_duration = "1 year"
-
-[taler-exchange-secmod-eddsa]
-lookahead_sign = "1 year"
-overlap_duration = "1 year"
-
-[coin_kudo_1]
-value= EUR:0.01
-duration_withdraw= "1 year"
-duration_spend= "1 year"
-duration_legal= "1 year"
-fee_withdraw= EUR:0.00
-fee_deposit= EUR:0.00
-fee_refresh= EUR:0.00
-fee_refund= EUR:0.00
-cipher= RSA
-rsa_keysize= 2048
-age_restricted= NO
-
-[coin_kudo_2]
-value= EUR:0.02
-duration_withdraw= "1 year"
-duration_spend= "1 year"
-duration_legal= "1 year"
-fee_withdraw= EUR:0.00
-fee_deposit= EUR:0.00
-fee_refresh= EUR:0.00
-fee_refund= EUR:0.00
-cipher= RSA
-rsa_keysize= 2048
-age_restricted= NO
diff --git a/.jjconflict-side-1/default/assets/privacy/en/0.md b/.jjconflict-side-1/default/assets/privacy/en/0.md
deleted file mode 100644
index 9c8e6b15..00000000
--- a/.jjconflict-side-1/default/assets/privacy/en/0.md
+++ /dev/null
@@ -1,8 +0,0 @@
-# Privacy Policy
-
-Welcome!
-This is a placeholder Privacy Policy file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/assets/privacy/en/0.txt b/.jjconflict-side-1/default/assets/privacy/en/0.txt
deleted file mode 100644
index 9c8e6b15..00000000
--- a/.jjconflict-side-1/default/assets/privacy/en/0.txt
+++ /dev/null
@@ -1,8 +0,0 @@
-# Privacy Policy
-
-Welcome!
-This is a placeholder Privacy Policy file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/assets/terms/en/0.md b/.jjconflict-side-1/default/assets/terms/en/0.md
deleted file mode 100644
index 033a5937..00000000
--- a/.jjconflict-side-1/default/assets/terms/en/0.md
+++ /dev/null
@@ -1,8 +0,0 @@
-# Terms of Service
-
-Welcome!
-This is a placeholder Terms of Service file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/assets/terms/en/0.txt b/.jjconflict-side-1/default/assets/terms/en/0.txt
deleted file mode 100644
index 033a5937..00000000
--- a/.jjconflict-side-1/default/assets/terms/en/0.txt
+++ /dev/null
@@ -1,8 +0,0 @@
-# Terms of Service
-
-Welcome!
-This is a placeholder Terms of Service file.
-
-
-------------------------------------------
-MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/master_offline_private_key b/.jjconflict-side-1/default/master_offline_private_key
deleted file mode 100644
index 739df007..00000000
Binary files a/.jjconflict-side-1/default/master_offline_private_key and /dev/null differ
diff --git a/.jjconflict-side-1/dune-project b/.jjconflict-side-1/dune-project
deleted file mode 100644
index d4fc79ff..00000000
--- a/.jjconflict-side-1/dune-project
+++ /dev/null
@@ -1,46 +0,0 @@
-(lang dune 3.20)
-
-(name mte)
-
-(generate_opam_files true)
-
-; (source
-; (github username/reponame))
-
-(authors "Olivier Pierre ")
-
-(maintainers "Olivier Pierre ")
-
-(license AGPL-3.0-only)
-
-; (documentation https://url/to/documentation)
-
-(package
- (name mte)
- (synopsis "MTE - the MirageOS Taler Exchange")
- (description "A GNU Taler exchange implementation with the unikernel framework MirageOS")
- (tags
- ("GNU Taler" MirageOS unikernel OCaml crypto))
- (depends
- (ocaml (>= 5.3))
- base32
- caqti
- caqti-miou
- caqti-driver-pgx
- crunch
- vif
- jsont
- cohttp
- fmt
- bin
- angstrom
- mirage-crypto
- kdf
- digestif
- duration
- jsont
- cohttp
- ptime
- logs
- (ocamlformat :with-dev-setup)
- ))
diff --git a/.jjconflict-side-1/mte.opam b/.jjconflict-side-1/mte.opam
deleted file mode 100644
index 3d706521..00000000
--- a/.jjconflict-side-1/mte.opam
+++ /dev/null
@@ -1,49 +0,0 @@
-# This file is generated by dune, edit dune-project instead
-opam-version: "2.0"
-synopsis: "MTE - the MirageOS Taler Exchange"
-description:
- "A GNU Taler exchange implementation with the unikernel framework MirageOS"
-maintainer: ["Olivier Pierre "]
-authors: ["Olivier Pierre "]
-license: "AGPL-3.0-only"
-tags: ["GNU Taler" "MirageOS" "unikernel" "OCaml" "crypto"]
-depends: [
- "dune" {>= "3.20"}
- "ocaml" {>= "5.3"}
- "base32"
- "caqti"
- "caqti-miou"
- "caqti-driver-pgx"
- "crunch"
- "vif"
- "jsont"
- "cohttp"
- "fmt"
- "bin"
- "angstrom"
- "mirage-crypto"
- "kdf"
- "digestif"
- "duration"
- "jsont"
- "cohttp"
- "ptime"
- "logs"
- "ocamlformat" {with-dev-setup}
- "odoc" {with-doc}
-]
-build: [
- ["dune" "subst"] {dev}
- [
- "dune"
- "build"
- "-p"
- name
- "-j"
- jobs
- "@install"
- "@runtest" {with-test}
- "@doc" {with-doc}
- ]
-]
-x-maintenance-intent: ["(latest)"]
diff --git a/.jjconflict-side-1/src/amount.ml b/.jjconflict-side-1/src/amount.ml
deleted file mode 100644
index c5e06082..00000000
--- a/.jjconflict-side-1/src/amount.ml
+++ /dev/null
@@ -1,127 +0,0 @@
-(* TODO
- have a currency agnostic amount_lib.ml
- and specialize amount.ml to Config.currency??
-
- have safe amount arithmetic *)
-type sign =
- | Sign_plus
- | Sign_minus
-
-type t = {
- sign: sign option;
- currency: string;
- value: Int64.t;
- fraction: Int32.t;
-}
-
-let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
-
-(* TODO
- the constraint is on the number of digits,
- so this wrong if leading 0s
- this depends on currency..? *)
-let fraction_upper_bound = Int32.of_int 100_000_000
-
-let make ~sign ~currency ~value ~fraction =
- if value < Int64.zero then Error "value is negative"
- else if fraction < Int32.zero then Error "fraction is negative"
- else if value > value_upper_bound then Error "value is greater than 2^52-1"
- else if fraction >= fraction_upper_bound then
- Error "fraction has more than 8 decimal digits"
- else Ok { sign; currency; value; fraction }
-
-module Parse = struct
- open Angstrom
-
- let sign =
- char '+' *> return (Some Sign_plus)
- <|> char '-' *> return (Some Sign_minus)
- <|> return None
-
- let currency =
- take_while1 (function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false)
- >>= fun s ->
- match String.length s < 12 with
- | false -> fail "currency is more than 11 characters"
- | true -> return s
-
- let int64 =
- take_while1 (function '0' .. '9' -> true | _ -> false)
- >>| Int64.of_string_opt
- >>= function
- | None -> fail "value is not a valid int64"
- | Some n when n >= value_upper_bound -> fail "value is greater than 2^52-1"
- | Some n -> return n
-
- let int32 =
- take_while1 (function '0' .. '9' -> true | _ -> false)
- >>| Int32.of_string_opt
- >>= function
- | None -> fail "fraction is not a valid int32"
- | Some n when n >= fraction_upper_bound ->
- fail "fraction is greater than 10^8-1"
- | Some n -> return n
-
- let amount =
- lift4
- (fun sign currency value fraction ->
- make ~sign ~currency ~value ~fraction)
- sign currency
- (char ':' *> int64)
- (char '.' *> int32 <|> return 0_l)
- <* end_of_input
-
- let f s = parse_string ~consume:Consume.All amount s |> Result.join
-end
-
-let of_string = Parse.f
-
-let pp =
- let open Fmt in
- let pp_sign ppf = function
- | Sign_plus -> char ppf '+'
- | Sign_minus -> char ppf '-'
- in
- fun ppf { sign; currency; value; fraction } ->
- (* TODO
- depends on the currency's number of fraction digits
- assumes value and fraction are in bounds *)
- pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction
-
-let to_string = Fmt.str "%a" pp
-
-(* - *)
-
-let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
-
-(* byte length of currency string *)
-let currency_len = 12
-
-let pad_currency_string s =
- let len = String.length s in
- assert (len < currency_len);
- let b = Bytes.make 12 '\x00' in
- Bytes.blit_string s 0 b 0 len;
- Bytes.to_string b
-
-(* binary decoding unused? *)
-let make_exn value fraction currency =
- match make ~sign:None ~currency ~value ~fraction with
- | Error _ -> Fmt.failwith "Amount of binary data failure"
- | Ok v -> v
-
-let bin =
- let open Bin in
- record make_exn
- |+ field neint64 (fun t -> t.value)
- |+ field neint32 (fun t -> t.fraction)
- |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
- |> sealr
-
-let bin_nbo =
- let open Bin in
- record make_exn
- |+ field beint64 (fun t -> t.value)
- |+ field beint32 (fun t -> t.fraction)
- |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
- |> sealr
diff --git a/.jjconflict-side-1/src/amount.mli b/.jjconflict-side-1/src/amount.mli
deleted file mode 100644
index f055430c..00000000
--- a/.jjconflict-side-1/src/amount.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-type sign =
- | Sign_plus
- | Sign_minus
-
-type t = private {
- sign: sign option;
- currency: string;
- value: Int64.t;
- fraction: Int32.t;
-}
-
-val make :
- sign:sign option ->
- currency:string ->
- value:Int64.t ->
- fraction:Int32.t ->
- (t, string) result
-
-val pp : Format.formatter -> t -> unit
-val to_string : t -> string
-val of_string : string -> (t, string) result
-
-(* - *)
-val jsont : t Jsont.t
-val bin : t Bin.t
-val bin_nbo : t Bin.t
-(* [caqti] is in pg_type.ml *)
diff --git a/.jjconflict-side-1/src/api.ml b/.jjconflict-side-1/src/api.ml
deleted file mode 100644
index 8a132db1..00000000
--- a/.jjconflict-side-1/src/api.ml
+++ /dev/null
@@ -1,1384 +0,0 @@
-(* TODO
- ppx?
- normalized JSON-object
- for signature of ExchangeKeysResponse.exetensions field
- option: correct use opt_mem or Jsont.option
- properly combine jsont for "interface DenomGroupRsa extends DenomGroupCommon"
- better types:
- - payto_uri
- - uri
- use of monotonic time for some validity_start/_end fields *)
-
-let protocol_version = "31:0:0"
-
-open Crypto
-open Signatures
-module DenominationHash = Hash.DenominationHash
-
-let encode_exn jsont v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok
-let encode jsont v = Jsont_bytesrw.encode_string jsont v
-let decode jsont v = Jsont_bytesrw.decode_string jsont v
-
-open Jsont.Object
-
-module Account_operation = struct
- type t =
- | Withdraw
- | Deposit
- | Merge
- | Balance
- | Close
- | Aggregate
- | Transaction
- | Refund
-
- let to_string t =
- String.uppercase_ascii
- @@
- match t with
- | Withdraw -> "withdraw"
- | Deposit -> "deposit"
- | Merge -> "merge"
- | Balance -> "balance"
- | Close -> "close"
- | Aggregate -> "aggregate"
- | Transaction -> "transaction"
- | Refund -> "refund"
-
- let jsont =
- [ Withdraw; Deposit; Merge; Balance; Close; Aggregate; Transaction; Refund ]
- |> List.map (fun t -> (to_string t, t))
- |> Jsont.enum ~kind:"account operation type"
-end
-
-module B32 = struct
- include B32
-
- let jsont = Jsont.of_of_string ~kind:"B32" B32.decode ~enc:B32.encode
-
- let caqti =
- Caqti_type.custom
- ~encode:(fun v -> Ok (B32.encode v))
- ~decode:B32.decode Caqti_type.string
-end
-
-(* TODO error response
- - use GANA error codes
- https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)
-module ErrorDetail = struct
- type t = {
- code: int;
- hint: string option;
- detail: string option;
- parameter: string option;
- path: string option;
- offset: string option;
- index: string option;
- object_: string option;
- currency: string option;
- type_expected: string option;
- type_actual: string option;
- extra: Jsont.json option;
- }
-
- let make code hint detail parameter path offset index object_ currency
- type_expected type_actual extra =
- {
- code;
- hint;
- detail;
- parameter;
- path;
- offset;
- index;
- object_;
- currency;
- type_expected;
- type_actual;
- extra;
- }
-
- let jsont =
- let code v = v.code in
- let hint v = v.hint in
- let detail v = v.detail in
- let parameter v = v.parameter in
- let path v = v.path in
- let offset v = v.offset in
- let index v = v.index in
- let object_ v = v.object_ in
- let currency v = v.currency in
- let type_expected v = v.type_expected in
- let type_actual v = v.type_actual in
- let extra v = v.extra in
-
- let open Jsont.Object in
- map ~kind:"ErrorDetail" make
- |> mem "code" Jsont.int ~enc:code
- |> opt_mem "hint" Jsont.string ~enc:hint
- |> opt_mem "detail" Jsont.string ~enc:detail
- |> opt_mem "parameter" Jsont.string ~enc:parameter
- |> opt_mem "path" Jsont.string ~enc:path
- |> opt_mem "offset" Jsont.string ~enc:offset
- |> opt_mem "index" Jsont.string ~enc:index
- |> opt_mem "object" Jsont.string ~enc:object_
- |> opt_mem "currency" Jsont.string ~enc:currency
- |> opt_mem "type_expected" Jsont.string ~enc:type_expected
- |> opt_mem "type_actual" Jsont.string ~enc:type_actual
- |> opt_mem "extra" (Jsont.any ()) ~enc:extra
- |> finish
-
- let make ?hint ?detail ?parameter ?path ?offset ?index ?object_ ?currency
- ?type_expected ?type_actual ?extra code =
- make code hint detail parameter path offset index object_ currency
- type_expected type_actual extra
-end
-
-module CurrencySpecification = struct
- type t = {
- name: string;
- num_fractional_input_digits: int;
- num_fractional_normal_digits: int;
- num_fractional_trailing_zero_digits: int;
- alt_unit_names: string;
- common_amounts: Amount.t list;
- }
-
- let jsont =
- let make name num_fractional_input_digits num_fractional_normal_digits
- num_fractional_trailing_zero_digits alt_unit_names common_amounts =
- {
- name;
- num_fractional_input_digits;
- num_fractional_normal_digits;
- num_fractional_trailing_zero_digits;
- alt_unit_names;
- common_amounts;
- }
- in
- let name v = v.name in
- let num_fractional_input_digits v = v.num_fractional_input_digits in
- let num_fractional_normal_digits v = v.num_fractional_normal_digits in
- let num_fractional_trailing_zero_digits v =
- v.num_fractional_trailing_zero_digits
- in
- let alt_unit_names v = v.alt_unit_names in
- let common_amounts v = v.common_amounts in
- map ~kind:"CurrencySpecification" make
- |> mem "name" Jsont.string ~enc:name
- |> mem "num_fractional_input_digits" Jsont.int
- ~enc:num_fractional_input_digits
- |> mem "num_fractional_normal_digits" Jsont.int
- ~enc:num_fractional_normal_digits
- |> mem "num_fractional_trailing_zero_digits" Jsont.int
- ~enc:num_fractional_trailing_zero_digits
- |> mem "alt_unit_names" Jsont.string ~enc:alt_unit_names
- |> mem "common_amounts" (Jsont.list Amount.jsont) ~enc:common_amounts
- |> finish
-end
-
-module ExchangeVersionResponse = struct
- type t = {
- version: string;
- (* todo jsont const string
- `name: "taler-exchange"` *)
- name: string;
- implementation: string option;
- currency: string;
- shopping_url: string option;
- open_banking_gateway: string option;
- currency_specification: CurrencySpecification.t;
- aml_spa_dialect: string option;
- }
-
- let jsont =
- let make version name implementation currency shopping_url
- open_banking_gateway currency_specification aml_spa_dialect =
- {
- version;
- name;
- implementation;
- currency;
- shopping_url;
- open_banking_gateway;
- currency_specification;
- aml_spa_dialect;
- }
- in
- let version v = v.version in
- let name v = v.name in
- let implementation v = v.implementation in
- let currency v = v.currency in
- let shopping_url v = v.shopping_url in
- let open_banking_gateway v = v.open_banking_gateway in
- let currency_specification v = v.currency_specification in
- let aml_spa_dialect v = v.aml_spa_dialect in
- map ~kind:"ExchangeVersionResponse" make
- |> mem "version" Jsont.string ~enc:version
- |> mem "name" Jsont.string ~enc:name
- |> mem "implementation" (Jsont.option Jsont.string) ~enc:implementation
- |> mem "currency" Jsont.string ~enc:currency
- |> mem "shopping_url" (Jsont.option Jsont.string) ~enc:shopping_url
- |> mem "open_banking_gateway"
- (Jsont.option Jsont.string)
- ~enc:open_banking_gateway
- |> mem "currency_specification" CurrencySpecification.jsont
- ~enc:currency_specification
- |> mem "aml_spa_dialect" (Jsont.option Jsont.string) ~enc:aml_spa_dialect
- |> finish
-end
-
-let config =
- let currency_specification =
- let open Config.Currency 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
- ExchangeVersionResponse.
- {
- version= protocol_version;
- name= "taler-exchange";
- currency= Config.currency;
- currency_specification;
- implementation= None;
- shopping_url= None;
- open_banking_gateway= None;
- aml_spa_dialect= None;
- }
-
-module RsaDenominationKey = struct
- type t = {
- age_mask: int;
- rsa_pub: RsaPublicKey.t;
- }
-
- let jsont =
- let make age_mask rsa_pub = { age_mask; rsa_pub } in
- let age_mask v = v.age_mask in
- let rsa_pub v = v.rsa_pub in
- Jsont.Object.map ~kind:"RsaDenominationKey" make
- |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask
- |> Jsont.Object.mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
- |> Jsont.Object.finish
-end
-
-(* ! Clause Schnorr cipher is not supported *)
-module DenominationKey = struct
- type t = Rsa of RsaDenominationKey.t
-
- let to_octets = function Rsa denom -> RsaPublicKey.to_octets denom.rsa_pub
-
- let of_cs _v =
- Jsont.Error.msg Jsont.Meta.none "CSDenominationKey are not supported"
-
- let of_rsa v = Rsa v
-
- let jsont =
- let rsa = Case.map "RSA" RsaDenominationKey.jsont ~dec:of_rsa in
- let cs = Case.map "CS" zero ~dec:of_cs in
- let enc_case = function Rsa v -> Case.value rsa v in
- let cases = Case.[ make rsa; make cs ] in
- map ~kind:"DenominationKey" Fun.id
- |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
- |> finish
-end
-
-module FutureSignKey = struct
- type t = {
- key: EddsaPublicKey.t;
- stamp_start: Timestamp.t;
- stamp_expire: Timestamp.t;
- stamp_end: Timestamp.t;
- signkey_secmod_sig: SigningKeyAnnouncement.t;
- }
-
- let jsont =
- let make key stamp_start stamp_expire stamp_end signkey_secmod_sig =
- { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
- in
- let key v = v.key in
- let stamp_start v = v.stamp_start in
- let stamp_expire v = v.stamp_expire in
- let stamp_end v = v.stamp_end in
- let signkey_secmod_sig v = v.signkey_secmod_sig in
- map ~kind:"FutureSignKey" make
- |> mem "key" EddsaPublicKey.jsont ~enc:key
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
- |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
- |> mem "signkey_secmod_sig" SigningKeyAnnouncement.jsont
- ~enc:signkey_secmod_sig
- |> finish
-end
-
-module FutureDenom = struct
- type t = {
- section_name: string;
- value: Amount.t;
- stamp_start: Timestamp.t;
- stamp_expire_withdraw: Timestamp.t;
- stamp_expire_deposit: Timestamp.t;
- stamp_expire_legal: Timestamp.t;
- denom_pub: DenominationKey.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- denom_secmod_sig: DenominationKeyAnnouncement.t;
- }
-
- let jsont =
- let make 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 =
- {
- 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;
- }
- in
- let section_name t = t.section_name in
- let value t = t.value in
- let stamp_start t = t.stamp_start in
- let stamp_expire_withdraw t = t.stamp_expire_withdraw in
- let stamp_expire_deposit t = t.stamp_expire_deposit in
- let stamp_expire_legal t = t.stamp_expire_legal in
- let denom_pub t = t.denom_pub in
- let fee_withdraw t = t.fee_withdraw in
- let fee_deposit t = t.fee_deposit in
- let fee_refresh t = t.fee_refresh in
- let fee_refund t = t.fee_refund in
- let denom_secmod_sig t = t.denom_secmod_sig in
- map ~kind:"FutureDenom" make
- |> mem "section_name" Jsont.string ~enc:section_name
- |> mem "value" Amount.jsont ~enc:value
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
- |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
- |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
- |> mem "denom_pub" DenominationKey.jsont ~enc:denom_pub
- |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
- |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
- |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
- |> mem "fee_refund" Amount.jsont ~enc:fee_refund
- |> mem "denom_secmod_sig" DenominationKeyAnnouncement.jsont
- ~enc:denom_secmod_sig
- |> finish
-end
-
-module FutureKeysResponse = struct
- type t = {
- future_denoms: FutureDenom.t list;
- future_signkeys: FutureSignKey.t list;
- master_pub: EddsaPublicKey.t;
- denom_secmod_public_key: EddsaPublicKey.t;
- signkey_secmod_public_key: EddsaPublicKey.t;
- }
-
- let jsont =
- let make future_denoms future_signkeys master_pub denom_secmod_public_key
- signkey_secmod_public_key =
- {
- future_denoms;
- future_signkeys;
- master_pub;
- denom_secmod_public_key;
- signkey_secmod_public_key;
- }
- in
- let future_denoms t = t.future_denoms in
- let future_signkeys t = t.future_signkeys in
- let master_pub t = t.master_pub in
- let denom_secmod_public_key t = t.denom_secmod_public_key in
- let signkey_secmod_public_key t = t.signkey_secmod_public_key in
- map ~kind:"FutureKeysResponse" make
- |> mem "future_denoms" (Jsont.list FutureDenom.jsont) ~enc:future_denoms
- |> mem "future_signkeys"
- (Jsont.list FutureSignKey.jsont)
- ~enc:future_signkeys
- |> mem "master_pub" EddsaPublicKey.jsont ~enc:master_pub
- |> mem "denom_secmod_public_key" EddsaPublicKey.jsont
- ~enc:denom_secmod_public_key
- |> mem "signkey_secmod_public_key" EddsaPublicKey.jsont
- ~enc:signkey_secmod_public_key
- |> finish
-end
-
-module SignKeySignature = struct
- type t = {
- key: EddsaPublicKey.t;
- master_sig: ExchangeSigningKeyValidity.t;
- }
-
- let jsont =
- let make key master_sig = { key; master_sig } in
- let key v = v.key in
- let master_sig v = v.master_sig in
- map ~kind:"SignKeySignature" make
- |> mem "key" EddsaPublicKey.jsont ~enc:key
- |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
- |> finish
-end
-
-module DenomSignature = struct
- type t = {
- h_denom_pub: DenominationHash.t;
- master_sig: DenominationKeyValidity.t;
- }
-
- let jsont =
- let make h_denom_pub master_sig = { h_denom_pub; master_sig } in
- let h_denom_pub v = v.h_denom_pub in
- let master_sig v = v.master_sig in
- map ~kind:"DenomSignature" make
- |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub
- |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
- |> finish
-end
-
-module MasterSignatures = struct
- type t = {
- denom_sigs: DenomSignature.t list;
- signkey_sigs: SignKeySignature.t list;
- }
-
- let jsont =
- let make denom_sigs signkey_sigs = { denom_sigs; signkey_sigs } in
- let denom_sigs v = v.denom_sigs in
- let signkey_sigs v = v.signkey_sigs in
- map ~kind:"MasterSignatures" make
- |> mem "denom_sigs" (Jsont.list DenomSignature.jsont) ~enc:denom_sigs
- |> mem "signkey_sigs" (Jsont.list SignKeySignature.jsont) ~enc:signkey_sigs
- |> finish
-end
-
-module DenomRevocationSignature = struct
- type t = { master_sig: MasterDenominationKeyRevocation.t }
-
- let jsont =
- let make master_sig = { master_sig } in
- let enc v = v.master_sig in
- map ~kind:"DenomRevocationSignature" make
- |> mem "master_sig" MasterDenominationKeyRevocation.jsont ~enc
- |> finish
-end
-
-module SignkeyRevocationSignature = struct
- type t = { master_sig: MasterSigningKeyRevocation.t }
-
- let jsont =
- let make master_sig = { master_sig } in
- let enc v = v.master_sig in
- map ~kind:"SignkeyRevocationSignature" make
- |> mem "master_sig" MasterSigningKeyRevocation.jsont ~enc
- |> finish
-end
-
-module AuditorSetupMessage = struct
- type t = {
- auditor_url: string;
- auditor_name: string;
- auditor_pub: EddsaPublicKey.t;
- master_sig: MasterAddAuditor.t;
- validity_start: Timestamp.t;
- }
-
- let jsont =
- let make auditor_url auditor_name auditor_pub master_sig validity_start =
- { auditor_url; auditor_name; auditor_pub; master_sig; validity_start }
- in
- let auditor_url v = v.auditor_url in
- let auditor_name v = v.auditor_name in
- let auditor_pub v = v.auditor_pub in
- let master_sig v = v.master_sig in
- let validity_start v = v.validity_start in
- map ~kind:"AuditorSetupMessage" make
- |> mem "auditor_url" Jsont.string ~enc:auditor_url
- |> mem "auditor_name" Jsont.string ~enc:auditor_name
- |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub
- |> mem "master_sig" MasterAddAuditor.jsont ~enc:master_sig
- |> mem "validity_start" Timestamp.jsont ~enc:validity_start
- |> finish
-end
-
-module AuditorTeardownMessage = struct
- type t = {
- master_sig: MasterDelAuditor.t;
- validity_end: Timestamp.t;
- }
-
- let jsont =
- let make master_sig validity_end = { master_sig; validity_end } in
- let master_sig v = v.master_sig in
- let validity_end v = v.validity_end in
- map ~kind:"AuditorTeardownMessage" make
- |> mem "master_sig" MasterDelAuditor.jsont ~enc:master_sig
- |> mem "validity_end" Timestamp.jsont ~enc:validity_end
- |> finish
-end
-
-module WireFeeSetupMessage = struct
- type t = {
- wire_method: string;
- master_sig_wire: MasterWireFee.t;
- fee_start: Timestamp.t;
- fee_end: Timestamp.t;
- closing_fee: Amount.t;
- wire_fee: Amount.t;
- }
-
- let jsont =
- let make wire_method master_sig_wire fee_start fee_end closing_fee wire_fee
- =
- {
- wire_method;
- master_sig_wire;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- }
- in
- let wire_method v = v.wire_method in
- let master_sig_wire v = v.master_sig_wire in
- let fee_start v = v.fee_start in
- let fee_end v = v.fee_end in
- let closing_fee v = v.closing_fee in
- let wire_fee v = v.wire_fee in
- map ~kind:"WireFeeSetupMessage" make
- |> mem "wire_method" Jsont.string ~enc:wire_method
- |> mem "master_sig_wire" MasterWireFee.jsont ~enc:master_sig_wire
- |> mem "fee_start" Timestamp.jsont ~enc:fee_start
- |> mem "fee_end" Timestamp.jsont ~enc:fee_end
- |> mem "closing_fee" Amount.jsont ~enc:closing_fee
- |> mem "wire_fee" Amount.jsont ~enc:wire_fee
- |> finish
-end
-
-module GlobalFees = struct
- type t = {
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- history_fee: Amount.t;
- account_fee: Amount.t;
- purse_fee: Amount.t;
- history_expiration: Time.Relative.t;
- purse_account_limit: int32;
- purse_timeout: Time.Relative.t;
- master_sig: GlobalFees.t;
- }
-
- let jsont =
- let make start_date end_date history_fee account_fee purse_fee
- history_expiration purse_account_limit purse_timeout master_sig =
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- }
- in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let history_fee v = v.history_fee in
- let account_fee v = v.account_fee in
- let purse_fee v = v.purse_fee in
- let history_expiration v = v.history_expiration in
- let purse_account_limit v = v.purse_account_limit in
- let purse_timeout v = v.purse_timeout in
- let master_sig v = v.master_sig in
- map ~kind:"GlobalFees" make
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "history_fee" Amount.jsont ~enc:history_fee
- |> mem "account_fee" Amount.jsont ~enc:account_fee
- |> mem "purse_fee" Amount.jsont ~enc:purse_fee
- |> mem "history_expiration" Time.Relative.jsont ~enc:history_expiration
- |> mem "purse_account_limit" Jsont.int32 ~enc:purse_account_limit
- |> mem "purse_timeout" Time.Relative.jsont ~enc:purse_timeout
- |> mem "master_sig" GlobalFees.jsont ~enc:master_sig
- |> finish
-end
-
-module WireSetupMessage = struct
- type t = {
- payto_uri: string;
- master_sig_wire: MasterWireDetails.t;
- master_sig_add: MasterAddWire.t;
- validity_start: Timestamp.t;
- bank_label: string option;
- priority: int option;
- }
-
- let jsont =
- let make payto_uri master_sig_wire master_sig_add validity_start bank_label
- priority =
- {
- payto_uri;
- master_sig_wire;
- master_sig_add;
- validity_start;
- bank_label;
- priority;
- }
- in
- let payto_uri v = v.payto_uri in
- let master_sig_wire v = v.master_sig_wire in
- let master_sig_add v = v.master_sig_add in
- let validity_start v = v.validity_start in
- let bank_label v = v.bank_label in
- let priority v = v.priority in
- map ~kind:"WireSetupMessage" make
- |> mem "payto_uri" Jsont.string ~enc:payto_uri
- |> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire
- |> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add
- |> mem "validity_start" Timestamp.jsont ~enc:validity_start
- |> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label
- |> mem "priority" (Jsont.option Jsont.int) ~enc:priority
- |> finish
-end
-
-module WireTeardownMessage = struct
- type t = {
- payto_uri: string;
- master_sig_del: MasterDelWire.t;
- validity_end: Timestamp.t;
- }
-
- let jsont =
- let make payto_uri master_sig_del validity_end =
- { payto_uri; master_sig_del; validity_end }
- in
- let payto_uri v = v.payto_uri in
- let master_sig_del v = v.master_sig_del in
- let validity_end v = v.validity_end in
- map ~kind:"WireTeardownMessage" make
- |> mem "payto_uri" Jsont.string ~enc:payto_uri
- |> mem "master_sig_del" MasterDelWire.jsont ~enc:master_sig_del
- |> mem "validity_end" Timestamp.jsont ~enc:validity_end
- |> finish
-end
-
-module DrainProfitsMessage = struct
- type t = {
- wtid: B32.t;
- debit_account_section: string;
- credit_payto_uri: string;
- date: Timestamp.t;
- amount: Amount.t;
- master_sig: MasterDrainProfit.t;
- }
-
- let jsont =
- let make debit_account_section credit_payto_uri wtid master_sig date amount
- =
- {
- debit_account_section;
- credit_payto_uri;
- wtid;
- master_sig;
- date;
- amount;
- }
- in
- let debit_account_section v = v.debit_account_section in
- let credit_payto_uri v = v.credit_payto_uri in
- let wtid v = v.wtid in
- let master_sig v = v.master_sig in
- let date v = v.date in
- let amount v = v.amount in
- map ~kind:"DrainProfitsMessage" make
- |> mem "debit_account_section" Jsont.string ~enc:debit_account_section
- |> mem "credit_payto_uri" Jsont.string ~enc:credit_payto_uri
- |> mem "wtid" B32.jsont ~enc:wtid
- |> mem "master_sig" MasterDrainProfit.jsont ~enc:master_sig
- |> mem "date" Timestamp.jsont ~enc:date
- |> mem "amount" Amount.jsont ~enc:amount
- |> finish
-end
-
-module AmlOfficerSetup = struct
- type t = {
- officer_pub: EddsaPublicKey.t;
- master_sig: MasterAmlOfficerStatus.t;
- officer_name: string;
- is_active: bool;
- read_only: bool;
- change_date: Timestamp.t;
- }
-
- let jsont =
- let make officer_pub officer_name is_active read_only master_sig change_date
- =
- {
- officer_pub;
- officer_name;
- is_active;
- read_only;
- master_sig;
- change_date;
- }
- in
- let officer_pub v = v.officer_pub in
- let officer_name v = v.officer_name in
- let is_active v = v.is_active in
- let read_only v = v.read_only in
- let master_sig v = v.master_sig in
- let change_date v = v.change_date in
- map ~kind:"AmlOfficerSetup" make
- |> mem "officer_pub" EddsaPublicKey.jsont ~enc:officer_pub
- |> mem "officer_name" Jsont.string ~enc:officer_name
- |> mem "is_active" Jsont.bool ~enc:is_active
- |> mem "read_only" Jsont.bool ~enc:read_only
- |> mem "master_sig" MasterAmlOfficerStatus.jsont ~enc:master_sig
- |> mem "change_date" Timestamp.jsont ~enc:change_date
- |> finish
-end
-
-module ExchangePartnerSetupRequest = struct
- type t = {
- partner_base_url: string;
- partner_pub: EddsaPublicKey.t;
- wad_frequency: Time.Relative.t;
- master_sig: PartnerConfiguration.t;
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- wad_fee: Amount.t;
- }
-
- let jsont =
- let make partner_base_url partner_pub wad_frequency master_sig start_date
- end_date wad_fee =
- {
- partner_base_url;
- partner_pub;
- wad_frequency;
- master_sig;
- start_date;
- end_date;
- wad_fee;
- }
- in
- let partner_base_url v = v.partner_base_url in
- let partner_pub v = v.partner_pub in
- let wad_frequency v = v.wad_frequency in
- let master_sig v = v.master_sig in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let wad_fee v = v.wad_fee in
- map ~kind:"ExchangePartnerSetupRequest" make
- |> mem "partner_base_url" Jsont.string ~enc:partner_base_url
- |> mem "partner_pub" EddsaPublicKey.jsont ~enc:partner_pub
- |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency
- |> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "wad_fee" Amount.jsont ~enc:wad_fee
- |> finish
-end
-
-(* -- types for /keys -- *)
-
-module ExchangePartnerListEntry = struct
- type t = {
- partner_base_url: string;
- partner_master_pub: EddsaPublicKey.t;
- wad_fee: Amount.t;
- wad_frequency: Time.Relative.t;
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- master_sig: WadPartnerSignature.t;
- }
-
- let jsont =
- let make partner_base_url partner_master_pub wad_fee wad_frequency
- start_date end_date master_sig =
- {
- partner_base_url;
- partner_master_pub;
- wad_fee;
- wad_frequency;
- start_date;
- end_date;
- master_sig;
- }
- in
- let partner_base_url v = v.partner_base_url in
- let partner_master_pub v = v.partner_master_pub in
- let wad_fee v = v.wad_fee in
- let wad_frequency v = v.wad_frequency in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let master_sig v = v.master_sig in
- map ~kind:"ExchangePartnerListEntry" make
- |> mem "partner_base_url" Jsont.string ~enc:partner_base_url
- |> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub
- |> mem "wad_fee" Amount.jsont ~enc:wad_fee
- |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "master_sig" WadPartnerSignature.jsont ~enc:master_sig
- |> finish
-end
-
-module AggregateTransferFee = struct
- type t = {
- wire_fee: Amount.t;
- closing_fee: Amount.t;
- start_date: Timestamp.t;
- end_date: Timestamp.t;
- sig_: MasterWireFee.t;
- }
-
- let jsont =
- let make wire_fee closing_fee start_date end_date sig_ =
- { wire_fee; closing_fee; start_date; end_date; sig_ }
- in
- let wire_fee v = v.wire_fee in
- let closing_fee v = v.closing_fee in
- let start_date v = v.start_date in
- let end_date v = v.end_date in
- let sig_ v = v.sig_ in
- map ~kind:"AggregateTransferFee" make
- |> mem "wire_fee" Amount.jsont ~enc:wire_fee
- |> mem "closing_fee" Amount.jsont ~enc:closing_fee
- |> mem "start_date" Timestamp.jsont ~enc:start_date
- |> mem "end_date" Timestamp.jsont ~enc:end_date
- |> mem "sig" MasterWireFee.jsont ~enc:sig_
- |> finish
-end
-
-module AuditorDenominationKey = struct
- type t = {
- denom_pub_h: DenominationHash.t;
- auditor_sig: ExchangeKeyValidity.t;
- }
-
- let jsont =
- let make denom_pub_h auditor_sig = { denom_pub_h; auditor_sig } in
- let denom_pub_h v = v.denom_pub_h in
- let auditor_sig v = v.auditor_sig in
- map ~kind:"AuditorDenominationKey" make
- |> mem "denom_pub_h" DenominationHash.jsont ~enc:denom_pub_h
- |> mem "auditor_sig" ExchangeKeyValidity.jsont ~enc:auditor_sig
- |> finish
-end
-
-module AuditorKeys = struct
- type t = {
- auditor_pub: EddsaPublicKey.t;
- auditor_url: string;
- auditor_name: string;
- denomination_keys: AuditorDenominationKey.t list;
- }
-
- let jsont =
- let make auditor_pub auditor_url auditor_name denomination_keys =
- { auditor_pub; auditor_url; auditor_name; denomination_keys }
- in
- let auditor_pub v = v.auditor_pub in
- let auditor_url v = v.auditor_url in
- let auditor_name v = v.auditor_name in
- let denomination_keys v = v.denomination_keys in
- map ~kind:"AuditorKeys" make
- |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub
- |> mem "auditor_url" Jsont.string ~enc:auditor_url
- |> mem "auditor_name" Jsont.string ~enc:auditor_name
- |> mem "denomination_keys"
- (Jsont.list AuditorDenominationKey.jsont)
- ~enc:denomination_keys
- |> finish
-end
-
-module SignKey = struct
- type t = {
- key: EddsaPublicKey.t;
- stamp_start: Timestamp.t;
- stamp_expire: Timestamp.t;
- stamp_end: Timestamp.t;
- master_sig: ExchangeSigningKeyValidity.t;
- }
-
- (* TODO rm one of them *)
- let of_signkey
- Signkey.
- {
- pub;
- stamp_start;
- stamp_expire;
- stamp_end;
- master_sig;
- revoked_sig= _;
- } =
- { key= pub; stamp_start; stamp_expire; stamp_end; master_sig }
-
- let jsont =
- let make key stamp_start stamp_expire stamp_end master_sig =
- { key; stamp_start; stamp_expire; stamp_end; master_sig }
- in
- let key v = v.key in
- let stamp_start v = v.stamp_start in
- let stamp_expire v = v.stamp_expire in
- let stamp_end v = v.stamp_end in
- let master_sig v = v.master_sig in
- map ~kind:"SignKey" make
- |> mem "key" EddsaPublicKey.jsont ~enc:key
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
- |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
- |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
- |> finish
-end
-
-module RecoupDenoms = struct
- type t = { h_denom_pub: DenominationHash.t }
-
- let jsont =
- let make h_denom_pub = { h_denom_pub } in
- let h_denom_pub v = v.h_denom_pub in
- map ~kind:"RecoupDenoms" make
- |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub
- |> finish
-end
-
-module RsaDenom = struct
- (* correspond to: ({ rsa_pub: RsaPublicKey;} & DenomCommon) *)
- type t = {
- rsa_pub: RsaPublicKey.t;
- master_sig: DenominationKeyValidity.t;
- stamp_start: Timestamp.t;
- stamp_expire_withdraw: Timestamp.t;
- stamp_expire_deposit: Timestamp.t;
- stamp_expire_legal: Timestamp.t;
- lost: bool option;
- }
-
- let jsont =
- let make rsa_pub master_sig stamp_start stamp_expire_withdraw
- stamp_expire_deposit stamp_expire_legal lost =
- {
- rsa_pub;
- master_sig;
- stamp_start;
- stamp_expire_withdraw;
- stamp_expire_deposit;
- stamp_expire_legal;
- lost;
- }
- in
- let rsa_pub v = v.rsa_pub in
- let master_sig v = v.master_sig in
- let stamp_start v = v.stamp_start in
- let stamp_expire_withdraw v = v.stamp_expire_withdraw in
- let stamp_expire_deposit v = v.stamp_expire_deposit in
- let stamp_expire_legal v = v.stamp_expire_legal in
- let lost v = v.lost in
- map ~kind:"RsaDenom" make
- |> mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
- |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
- |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
- |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
- |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
- |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
- |> mem "lost" (Jsont.option Jsont.bool) ~enc:lost
- |> finish
-end
-
-module RsaDenomGroup = struct
- type t = {
- denoms: RsaDenom.t list;
- value: Amount.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- }
-
- let jsont =
- let make denoms value fee_withdraw fee_deposit fee_refresh fee_refund =
- { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
- in
- let denoms v = v.denoms in
- let value v = v.value in
- let fee_withdraw v = v.fee_withdraw in
- let fee_deposit v = v.fee_deposit in
- let fee_refresh v = v.fee_refresh in
- let fee_refund v = v.fee_refund in
- map ~kind:"RsaDenomGroup" make
- |> mem "denoms" (Jsont.list RsaDenom.jsont) ~enc:denoms
- |> mem "value" Amount.jsont ~enc:value
- |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
- |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
- |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
- |> mem "fee_refund" Amount.jsont ~enc:fee_refund
- |> finish
-end
-
-module DenomGroup = struct
- type t = Rsa of RsaDenomGroup.t
-
- let of_rsa v = Rsa v
-
- let of_cs _v =
- Jsont.Error.msg Jsont.Meta.none "CSDenomGroup are not supported"
-
- let of_rsa_age_restricted _v =
- Jsont.Error.msg Jsont.Meta.none
- "DenomGroupRsaAgeRestricted are not supported"
-
- let jsont =
- let rsa = Case.map "RSA" RsaDenomGroup.jsont ~dec:of_rsa in
- let cs = Case.map "CS" zero ~dec:of_cs in
- let rsa_age_restricted =
- Case.map "RSA+age_restricted" zero ~dec:of_rsa_age_restricted
- in
- let cs_age_restricted = Case.map "CS+age_restricted" zero ~dec:of_cs in
- let enc_case = function Rsa v -> Case.value rsa v in
- let cases =
- Case.
- [ make rsa; make cs; make rsa_age_restricted; make cs_age_restricted ]
- in
- map ~kind:"DenomGroup" Fun.id
- |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
- |> finish
-end
-
-module AccountLimit = struct
- type t = {
- operation_type: Account_operation.t;
- timeframe: Time.Relative.t;
- threshold: Amount.t;
- soft_limit: bool option;
- }
-
- let jsont =
- let make operation_type timeframe threshold soft_limit =
- { operation_type; timeframe; threshold; soft_limit }
- in
- let operation_type v = v.operation_type in
- let timeframe v = v.timeframe in
- let threshold v = v.threshold in
- let soft_limit v = v.soft_limit in
- map ~kind:"AccountLimit" make
- |> mem "operation_type" Account_operation.jsont ~enc:operation_type
- |> mem "timeframe" Time.Relative.jsont ~enc:timeframe
- |> mem "threshold" Amount.jsont ~enc:threshold
- |> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit
- |> finish
-end
-
-module ZeroLimitedOperation = struct
- type t = { operation_type: Account_operation.t }
-
- let jsont =
- let make operation_type = { operation_type } in
- let operation_type v = v.operation_type in
- map ~kind:"ZeroLimitedOperation" make
- |> mem "operation_type" Account_operation.jsont ~enc:operation_type
- |> finish
-end
-
-module RegexAccountRestriction = struct
- type t = {
- payto_regex: string;
- human_hint: string;
- (* Map from IETF BCP 47 language tags to localized human hints. *)
- human_hint_i18n: string option;
- }
-
- let jsont =
- let make payto_regex human_hint human_hint_i18n =
- { payto_regex; human_hint; human_hint_i18n }
- in
- let payto_regex v = v.payto_regex in
- let human_hint v = v.human_hint in
- let human_hint_i18n v = v.human_hint_i18n in
- map ~kind:"RegexAccountRestriction" make
- |> mem "payto_regex" Jsont.string ~enc:payto_regex
- |> mem "human_hint" Jsont.string ~enc:human_hint
- |> opt_mem "human_hint_i18n" Jsont.string ~enc:human_hint_i18n
- |> finish
-end
-
-module AccountRestriction = struct
- type t =
- | Deny
- | Regex of RegexAccountRestriction.t
-
- let of_regex v = Regex v
- let of_deny () = Deny
-
- let jsont =
- let regex = Case.map "regex" RegexAccountRestriction.jsont ~dec:of_regex in
- let deny = Case.map "deny" zero ~dec:of_deny in
- let enc_case = function
- | Regex v -> Case.value regex v
- | Deny -> Case.value deny ()
- in
- let cases = Case.[ make regex; make deny ] in
- map ~kind:"AccountRestriction" Fun.id
- |> case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
- |> finish
-end
-
-module ExchangeWireAccount = struct
- type t = {
- payto_uri: string;
- conversion_url: string option;
- credit_restrictions: AccountRestriction.t list;
- debit_restrictions: AccountRestriction.t list;
- master_sig: MasterWireDetails.t;
- bank_label: string option;
- priority: int option;
- }
-
- let jsont =
- let make payto_uri conversion_url credit_restrictions debit_restrictions
- master_sig bank_label priority =
- {
- payto_uri;
- conversion_url;
- credit_restrictions;
- debit_restrictions;
- master_sig;
- bank_label;
- priority;
- }
- in
- let payto_uri v = v.payto_uri in
- let conversion_url v = v.conversion_url in
- let credit_restrictions v = v.credit_restrictions in
- let debit_restrictions v = v.debit_restrictions in
- let master_sig v = v.master_sig in
- let bank_label v = v.bank_label in
- let priority v = v.priority in
- map ~kind:"ExchangeWireAccount" make
- |> mem "payto_uri" Jsont.string ~enc:payto_uri
- |> opt_mem "conversion_url" Jsont.string ~enc:conversion_url
- |> mem "credit_restrictions"
- (Jsont.list AccountRestriction.jsont)
- ~enc:credit_restrictions
- |> mem "debit_restrictions"
- (Jsont.list AccountRestriction.jsont)
- ~enc:debit_restrictions
- |> mem "master_sig" MasterWireDetails.jsont ~enc:master_sig
- |> opt_mem "bank_label" Jsont.string ~enc:bank_label
- |> opt_mem "priority" Jsont.int ~enc:priority
- |> finish
-end
-
-module ExtensionManifest = struct
- type t = {
- critical: bool;
- version: string;
- config: Jsont.json option;
- }
-
- let jsont =
- let make critical version config = { critical; version; config } in
- let critical v = v.critical in
- let version v = v.version in
- let config v = v.config in
- map ~kind:"ExtensionManifest" make
- |> mem "critical" Jsont.bool ~enc:critical
- |> mem "version" Jsont.string ~enc:version
- |> opt_mem "config" (Jsont.any ()) ~enc:config
- |> finish
-end
-
-module ExchangeKeysResponse = struct
- module String_map = Map.Make (String)
-
- type t = {
- version: string;
- base_url: string;
- currency: string;
- shopping_url: string option;
- open_banking_gateway: string option;
- bank_compliance_language: string option;
- currency_specification: CurrencySpecification.t;
- tiny_amount: Amount.t option;
- stefan_abs: Amount.t;
- stefan_log: Amount.t;
- stefan_lin: Float.t;
- asset_type: string;
- accounts: ExchangeWireAccount.t list;
- wire_fees: AggregateTransferFee.t list Stdlib.Map.Make(Stdlib.String).t;
- wads: ExchangePartnerListEntry.t list;
- rewards_allowed: bool;
- kyc_enabled: bool;
- disable_direct_deposit: bool;
- master_public_key: EddsaPublicKey.t;
- reserve_closing_delay: Time.Relative.t;
- wallet_balance_limit_without_kyc: Amount.t list option;
- hard_limits: AccountLimit.t list;
- zero_limits: ZeroLimitedOperation.t list;
- denominations: DenomGroup.t list;
- (* 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" *)
- exchange_sig: ExchangeKeySet.t;
- exchange_pub: EddsaPublicKey.t;
- recoup: RecoupDenoms.t list;
- global_fees: GlobalFees.t list;
- list_issue_date: Timestamp.t;
- auditors: AuditorKeys.t list;
- signkeys: SignKey.t list;
- extensions: ExtensionManifest.t Stdlib.Map.Make(Stdlib.String).t option;
- (* Signature by the exchange master key of the SHA-256 hash of the
- normalized JSON-object of field extensions, if it was set.
- The signature has purpose TALER_SIGNATURE_MASTER_EXTENSIONS. *)
- extensions_sig: EddsaSignature.t option;
- }
-
- let jsont =
- let make 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 =
- {
- 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;
- }
- in
-
- let version v = v.version in
- let base_url v = v.base_url in
- let currency v = v.currency in
- let shopping_url v = v.shopping_url in
- let open_banking_gateway v = v.open_banking_gateway in
- let bank_compliance_language v = v.bank_compliance_language in
- let currency_specification v = v.currency_specification in
- let tiny_amount v = v.tiny_amount in
- let stefan_abs v = v.stefan_abs in
- let stefan_log v = v.stefan_log in
- let stefan_lin v = v.stefan_lin in
- let asset_type v = v.asset_type in
- let accounts v = v.accounts in
- let wire_fees v = v.wire_fees in
- let wads v = v.wads in
- let rewards_allowed v = v.rewards_allowed in
- let kyc_enabled v = v.kyc_enabled in
- let disable_direct_deposit v = v.disable_direct_deposit in
- let master_public_key v = v.master_public_key in
- let reserve_closing_delay v = v.reserve_closing_delay in
- let wallet_balance_limit_without_kyc v =
- v.wallet_balance_limit_without_kyc
- in
- let hard_limits v = v.hard_limits in
- let zero_limits v = v.zero_limits in
- let denominations v = v.denominations in
- let exchange_sig v = v.exchange_sig in
- let exchange_pub v = v.exchange_pub in
- let recoup v = v.recoup in
- let global_fees v = v.global_fees in
- let list_issue_date v = v.list_issue_date in
- let auditors v = v.auditors in
- let signkeys v = v.signkeys in
- let extensions v = v.extensions in
- let extensions_sig v = v.extensions_sig in
- map ~kind:"ExchangeKeysResponse" make
- |> mem "version" Jsont.string ~enc:version
- |> mem "base_url" Jsont.string ~enc:base_url
- |> mem "currency" Jsont.string ~enc:currency
- |> opt_mem "shopping_url" Jsont.string ~enc:shopping_url
- |> opt_mem "open_banking_gateway" Jsont.string ~enc:open_banking_gateway
- |> opt_mem "bank_compliance_language" Jsont.string
- ~enc:bank_compliance_language
- |> mem "currency_specification" CurrencySpecification.jsont
- ~enc:currency_specification
- |> opt_mem "tiny_amount" Amount.jsont ~enc:tiny_amount
- |> mem "stefan_abs" Amount.jsont ~enc:stefan_abs
- |> mem "stefan_log" Amount.jsont ~enc:stefan_log
- |> mem "stefan_lin" Jsont.number ~enc:stefan_lin
- |> mem "asset_type" Jsont.string ~enc:asset_type
- |> mem "accounts" (Jsont.list ExchangeWireAccount.jsont) ~enc:accounts
- |> mem "wire_fees"
- (Jsont.Object.as_string_map (Jsont.list AggregateTransferFee.jsont))
- ~enc:wire_fees
- |> mem "wads" (Jsont.list ExchangePartnerListEntry.jsont) ~enc:wads
- |> mem "rewards_allowed" Jsont.bool ~enc:rewards_allowed
- |> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled
- |> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit
- |> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key
- |> mem "reserve_closing_delay" Time.Relative.jsont
- ~enc:reserve_closing_delay
- |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont)
- ~enc:wallet_balance_limit_without_kyc
- |> mem "hard_limits" (Jsont.list AccountLimit.jsont) ~enc:hard_limits
- |> mem "zero_limits"
- (Jsont.list ZeroLimitedOperation.jsont)
- ~enc:zero_limits
- |> mem "denominations" (Jsont.list DenomGroup.jsont) ~enc:denominations
- |> mem "exchange_sig" ExchangeKeySet.jsont ~enc:exchange_sig
- |> mem "exchange_pub" EddsaPublicKey.jsont ~enc:exchange_pub
- |> mem "recoup" (Jsont.list RecoupDenoms.jsont) ~enc:recoup
- |> mem "global_fees" (Jsont.list GlobalFees.jsont) ~enc:global_fees
- |> mem "list_issue_date" Timestamp.jsont ~enc:list_issue_date
- |> mem "auditors" (Jsont.list AuditorKeys.jsont) ~enc:auditors
- |> mem "signkeys" (Jsont.list SignKey.jsont) ~enc:signkeys
- |> opt_mem "extensions"
- (Jsont.Object.as_string_map ExtensionManifest.jsont)
- ~enc:extensions
- |> opt_mem "extensions_sig" EddsaSignature.jsont ~enc:extensions_sig
- |> finish
-end
diff --git a/.jjconflict-side-1/src/assets.ml b/.jjconflict-side-1/src/assets.ml
deleted file mode 100644
index 9313ee49..00000000
--- a/.jjconflict-side-1/src/assets.ml
+++ /dev/null
@@ -1,163 +0,0 @@
-(* https://docs.taler.net/design-documents/003-tos-rendering.html
-
- must support `text/plain` and `text/markdown` *)
-
-type t =
- | Terms
- | Privacy
-
-module Assets_config = struct
- (* hardcoded config just for static assets *)
- let default_lang = "en"
- let default_mimetype = ("text", "plain")
- let default_extension = ".txt"
- let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
- let base_dir = function Terms -> "terms" | Privacy -> "privacy"
-
- (* TODO this should be in the config like terms_etag *)
- let terms_legal_version = "0"
-end
-
-let etag k =
- match k with Terms -> Config.terms_etag | Privacy -> Config.privacy_etag
-
-let supported_lang_arr, supported_ext_arr =
- let aux t =
- let prefix = Fpath.v (Assets_config.base_dir t) in
- let path_l = List.map Fpath.v Assets_crunch.file_list in
- let path_l = List.filter_map (Fpath.rem_prefix prefix) path_l in
- let ext_l =
- path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
- in
- let lang_l =
- List.map
- (fun path ->
- match Fpath.segs path with
- | [] -> assert false
- | [ dir; _file ] -> dir
- | _l ->
- Fmt.failwith "invalid folder structure, file `%s` is misplaced"
- (Fpath.to_string Fpath.(prefix // path)))
- path_l
- in
- let lang_l = List.sort_uniq String.compare lang_l in
- let etag = (etag t).value in
- List.iter
- (fun path ->
- let etag' = Fpath.to_string (Fpath.rem_ext (Fpath.base path)) in
- if not @@ String.equal etag etag' then
- Fmt.failwith
- "filename of file `%s` does not match configuration ETAG value `%s`"
- (Fpath.to_string Fpath.(prefix // path))
- etag)
- path_l;
- if List.is_empty lang_l then Fmt.failwith "no language supported";
- if List.is_empty ext_l then Fmt.failwith "no mimetype supported";
- if not @@ List.mem Assets_config.default_lang lang_l then
- Fmt.failwith "default language `%s` files not found"
- Assets_config.default_lang;
- if not @@ List.mem ".txt" ext_l then
- Fmt.failwith "plain text file not found";
- if not @@ List.mem ".md" ext_l then Fmt.failwith "markdown file not found";
- List.iter
- (fun dir ->
- if String.length dir <> 2 then
- Fmt.failwith "language directory with invalid name: `%s`" dir)
- lang_l;
- if List.length path_l <> List.length ext_l * List.length lang_l then
- Fmt.failwith
- "invalid folder structure, all supported language must provide the \
- same set of file mimetype"
- else (lang_l, ext_l)
- in
- let lang_l, ext_l = aux Terms in
- let lang_l', ext_l' = aux Privacy in
- match
- List.equal String.equal lang_l lang_l'
- && List.equal String.equal ext_l ext_l'
- with
- | false ->
- Fmt.failwith
- "invalid folder structure, /terms and /privacy must support the same \
- set of languages and mimetypes"
- | true -> (Array.of_list lang_l, Array.of_list ext_l)
-
-module Mimetype = struct
- type t = string * string
-
- let pp fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
-
- let assoc =
- List.filter
- (fun (_mime, ext) -> Array.mem ext supported_ext_arr)
- [
- (("text", "plain"), ".txt");
- (("text", "markdown"), ".md");
- (("text", "html"), ".html");
- (("text", "html"), ".htm");
- (("application", "pdf"), ".pdf");
- (("image", "jpeg"), ".jpg");
- (("image", "jpeg"), ".jpeg");
- (("image", "png"), ".png");
- (("image", "gif"), ".gif");
- ]
-
- let arr =
- let all_supported, all_supported_ext = List.split assoc in
- match
- Array.find_opt
- (fun ext -> not @@ List.exists (( = ) ext) all_supported_ext)
- supported_ext_arr
- with
- | Some ext -> Fmt.failwith "extension `%s` unsupported" ext
- | None -> Array.of_list all_supported
-
- let default =
- match
- List.mem
- (Assets_config.default_mimetype, Assets_config.default_extension)
- assoc
- with
- | false ->
- Fmt.failwith "default content type `%a` not supported" pp
- Assets_config.default_mimetype
- | true -> Assets_config.default_mimetype
-
- let of_cohttp = function
- | Cohttp.Accept.MediaType (m, m_sub) ->
- Array.find_opt (( = ) (m, m_sub)) arr
- | AnyMediaSubtype m -> Array.find_opt (fun (m', _) -> String.equal m m') arr
- | AnyMedia -> Some default
-
- let to_extension_exn t =
- match List.assoc_opt t assoc with
- | None -> Fmt.failwith "Mimetype.to_extension failure: `%a` unknown" pp t
- | Some ext -> ext
-end
-
-module Language = struct
- type t = string
-
- let arr = supported_lang_arr
- let default = Assets_config.default_lang
-
- let of_cohttp = function
- | Cohttp.Accept.AnyLanguage -> Some default
- | Language language_range -> (
- (* ignore language subtags (e.g. "en-US" -> "en") *)
- match language_range with
- | [] -> assert false
- | lang :: _ when Array.mem lang supported_lang_arr -> Some lang
- | _ -> None)
-end
-
-(* ! lang and mime must be supported *)
-let get_content ~lang ~mime t =
- let ext = Mimetype.to_extension_exn mime in
- let path =
- Fpath.to_string
- Fpath.((v (Assets_config.base_dir t) / lang / (etag t).value) + ext)
- in
- match Assets_crunch.read path with
- | None -> Fmt.failwith "static file not found: `%s`" path
- | Some data -> data
diff --git a/.jjconflict-side-1/src/b32.ml b/.jjconflict-side-1/src/b32.ml
deleted file mode 100644
index 6bd06400..00000000
--- a/.jjconflict-side-1/src/b32.ml
+++ /dev/null
@@ -1,38 +0,0 @@
-(* Crockford's variant of Base32
- http://www.crockford.com/wrmg/base32.html
- except that:
- - 'U' is not excluded but also decodes to 'V'
- - '-' is not allowed
- - checksum is not allowed *)
-
-(* 'I' 'L' 'O' 'U' excluded
- no '=' padding in encoded string *)
-type t = string
-
-let alphabet = Base32.make_alphabet "0123456789ABCDEFGHJKMNPQRSTVWXYZ"
-
-let encode s =
- let s = Base32.encode_string ~alphabet s in
- (* remove '=' padding *)
- match String.index_opt s '=' with
- | None -> s
- | Some i -> String.sub s 0 i
-
-let decode s =
- let s =
- String.map
- (fun c ->
- match Char.uppercase_ascii c with
- | 'O' -> '0'
- | 'I' | 'L' -> '1'
- | 'U' -> 'V'
- | c -> c)
- s
- in
- (* restore padding for base32 lib *)
- let n = 8 - (String.length s mod 8) in
- let pad = String.make n '=' in
- let s = s ^ pad in
- match Base32.decode ~alphabet ~off:0 ~len:(String.length s) s with
- | Error (`Msg e) -> Error e
- | Ok v -> Ok v
diff --git a/.jjconflict-side-1/src/config.ml b/.jjconflict-side-1/src/config.ml
deleted file mode 100644
index 21666cf7..00000000
--- a/.jjconflict-side-1/src/config.ml
+++ /dev/null
@@ -1,203 +0,0 @@
-open Parse_config
-
-let config_filename = "mte.conf"
-let secrets_dir = Fpath.v "secrets"
-let secmod_dir = Fpath.(secrets_dir / "secmod")
-
-let config_data =
- match Assets_crunch.read config_filename with
- | None -> fail "static file not found: `%s`" config_filename
- | Some data ->
- let v = Config_section.parse data in
- v
-
-module Exchange = struct
- let get_opt field = get_opt config_data ~section:"exchange" ~field
- let get field = get config_data ~section:"exchange" ~field
-
- (* - *)
- let currency = (* todo: constraint on currency string *) get "currency"
- let currency_round_unit = get "currency_round_unit" |> amount
- let db = get "db" |> const_value "postgres"
- let attribute_encryption_key = get "attribute_encryption_key"
- let port = get "port" |> int
- let bind_to = get "bind_to"
- let master_public_key = get "master_public_key" |> ed25519
-
- (* TODO Defaults to 0.0 if not specified. *)
- let stefan_abs = get "stefan_abs" |> amount
- let stefan_log = get "stefan_log" |> amount
-
- let stefan_lin =
- get_opt "stefan_lin" |> Option.map float |> Option.value ~default:0.0
-
- let aggregator_idle_sleep_interval =
- get "aggregator_idle_sleep_interval" |> duration
-
- let closer_idle_sleep_interval = get "closer_idle_sleep_interval" |> duration
-
- let transfer_idle_sleep_interval =
- get "transfer_idle_sleep_interval" |> duration
-
- let wirewatch_idle_sleep_interval =
- get "wirewatch_idle_sleep_interval" |> duration
-
- let signkey_legal_duration = get "signkey_legal_duration" |> duration
- let max_keys_caching = get "max_keys_caching" |> duration
- let enable_kyc = get "enable_kyc" |> yes_no
- let terms_etag = get "terms_etag" |> etag
- let privacy_etag = get "privacy_etag" |> etag
- let base_url = get "base_url"
- let shopping_url = get_opt "shopping_url"
- let open_banking_gateway_url = get_opt "open_banking_gateway_url"
- let bank_compliance_language = get_opt "bank_compliance_language"
- let aml_spa_dialect = get_opt "aml_spa_dialect"
- let toplevel_redirect_url = get_opt "toplevel_redirect_url"
- let tiny_amount = get_opt "tiny_amount" |> Option.map amount
-
- (* not implemented or not relevant to MTE:
- let max_requests = get "max_requests" |> int
- aggregator_shard_size
- serve
- unixpath
- unixpath_mode
- terms_dir
- privacy_dir *)
-end
-
-module Exchangedb = struct
- let get field = get config_data ~section:"exchangedb" ~field
-
- (* - *)
- let idle_reserve_expiration_time =
- get "idle_reserve_expiration_time" |> duration
-
- let legal_reserve_expiration_time =
- get "legal_reserve_expiration_time" |> duration
-
- let aggregator_shift = get "aggregator_shift" |> duration
- let max_aml_program_runtime = get "max_aml_program_runtime" |> duration
- let default_purse_limit = get "default_purse_limit" |> int
-end
-
-module Exchangedb_postgres = struct
- let config =
- get config_data ~section:"exchangedb-postgres" ~field:"config" |> uri
-end
-
-module Currency = struct
- type t = {
- enabled: [ `YES | `NO ];
- code: string;
- name: string;
- fractional_input_digits: int;
- fractional_normal_digits: int;
- fractional_trailing_zero_digits: int;
- alt_unit_names: (int * string) list;
- }
-
- let currency_sections =
- List.filter
- (fun v -> String.starts_with ~prefix:"currency-" v.header)
- config_data
-
- let parse_currency section =
- let get field = get config_data ~section:section.header ~field in
- {
- enabled= get "enabled" |> yes_no;
- code= get "code";
- name= get "name";
- fractional_input_digits= get "fractional_input_digits" |> int;
- fractional_normal_digits= get "fractional_normal_digits" |> int;
- fractional_trailing_zero_digits=
- get "fractional_trailing_zero_digits" |> int;
- alt_unit_names=
- get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap;
- }
-
- let all_currencies = List.map parse_currency currency_sections
-
- (* I think the exchange only handle one currency *)
- let v =
- match
- List.find_opt (fun v -> v.code = Exchange.currency) all_currencies
- with
- | None ->
- fail "section `[currency-%s]` not found, currency `%s` is not defined"
- Exchange.currency Exchange.currency
- | Some v -> (
- match v.enabled = `YES with
- | false -> fail "currency `%s` is not enabled" Exchange.currency
- | true -> v)
-end
-
-module Coin = struct
- type t = {
- section_name: string;
- value: Amount.t;
- duration_withdraw: Time.Relative.t;
- duration_spend: Time.Relative.t;
- duration_legal: Time.Relative.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- cipher: [ (* `CS |*) `RSA ];
- rsa_keysize: int; (* : int option (only if `RSA) *)
- age_restricted: [ (*`YES|*) `NO ];
- }
-
- let coin_sections =
- List.filter
- (fun v ->
- (* note: here its a '_' not '-' *)
- String.starts_with ~prefix:"coin_" v.header)
- config_data
-
- let parse_coin section =
- let get field = get config_data ~section:section.header ~field in
- let section_name =
- String.sub section.header 5 (String.length section.header - 5)
- in
- {
- section_name;
- value= get "value" |> amount;
- duration_withdraw= get "duration_withdraw" |> duration;
- duration_spend= get "duration_spend" |> duration;
- duration_legal= get "duration_legal" |> duration;
- fee_withdraw= get "fee_withdraw" |> amount;
- fee_deposit= get "fee_deposit" |> amount;
- fee_refresh= get "fee_refresh" |> amount;
- fee_refund= get "fee_refund" |> amount;
- cipher= (get "cipher" |> const_value "RSA" |> fun _s -> `RSA);
- rsa_keysize= get "rsa_keysize" |> int;
- age_restricted=
- ( get "age_restricted" |> yes_no |> function
- | `NO -> `NO
- | `YES -> fail "`age_restricted = YES` is not supported" );
- }
-
- let all_coins = List.map parse_coin coin_sections
-end
-
-module Exchange_secmod_rsa = struct
- let get field =
- let section = "taler-exchange-secmod-" ^ "rsa" in
- get config_data ~section ~field
-
- let lookahead_sign = get "lookahead_sign" |> duration
- let overlap_duration = get "overlap_duration" |> duration
- (* not relevant: sm_priv_key key_dir unixpath *)
-end
-
-module Exchange_secmod_eddsa = struct
- let get field =
- let section = "taler-exchange-secmod-" ^ "eddsa" in
- get config_data ~section ~field
-
- let lookahead_sign = get "lookahead_sign" |> duration
- let overlap_duration = get "overlap_duration" |> duration
-end
-
-(* -- *)
-include Exchange
diff --git a/.jjconflict-side-1/src/crypto.ml b/.jjconflict-side-1/src/crypto.ml
deleted file mode 100644
index 99cabfea..00000000
--- a/.jjconflict-side-1/src/crypto.ml
+++ /dev/null
@@ -1,371 +0,0 @@
-open Syntax
-
-module Binary_format_rsa = struct
- (* RSA public key binary format
- https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html
- := { uint16_be: n size; uint16_be: e size; n; e}
-
- integer in big-endian format (MSB first)
- leading zeroes are stripped unless they are required to keep a value positive
- no 0-termination *)
-
- let z_array_to_octets (arr : Z.t array) =
- let nb = Array.length arr in
- let bits_arr = Array.map Mirage_crypto_pk.Z_extra.to_octets_be arr in
- let len_arr = Array.map String.length bits_arr in
- let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
- let b = Bytes.make len '\x00' in
- let pos = ref 0 in
- Array.iter
- (fun len ->
- Bytes.set_uint16_be b !pos len;
- pos := !pos + 2)
- len_arr;
- Array.iteri
- (fun i bits ->
- let len = len_arr.(i) in
- Bytes.blit_string bits 0 b !pos len;
- pos := !pos + len)
- bits_arr;
- Bytes.unsafe_to_string b
-
- let z_array_of_octets ~nb s =
- let s_len = String.length s in
- if s_len <= 2 * nb then Error "rsa of_octets error"
- else
- let pos = ref 0 in
- let len_arr =
- Array.init nb (fun _i ->
- let len = String.get_uint16_be s !pos in
- pos := !pos + 2;
- len)
- in
- let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
- if s_len <> len then Error "rsa of_octets error"
- else
- let z_arr =
- Array.init nb (fun i ->
- let len = len_arr.(i) in
- let s = String.sub s !pos len in
- let z = Mirage_crypto_pk.Z_extra.of_octets_be s in
- pos := !pos + len;
- z)
- in
- Ok z_arr
-
- let pub_to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) =
- z_array_to_octets [| n; e |]
-
- let pub_of_octets s =
- let* arr = z_array_of_octets ~nb:2 s in
- match arr with
- | [| n; e |] ->
- let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg in
- pub
- | _ -> assert false
-
- (* custom private key binary format <> than gcrypt *)
- let priv_to_octets ({ e; d; n; p; q; dp; dq; q' } : Mirage_crypto_pk.Rsa.priv)
- =
- z_array_to_octets [| e; d; n; p; q; dp; dq; q' |]
-
- let priv_of_octets s =
- let* arr = z_array_of_octets ~nb:8 s in
- match arr with
- | [| e; d; n; p; q; dp; dq; q' |] ->
- let+ priv =
- Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_err_msg
- in
- priv
- | _ -> assert false
-end
-
-module EddsaPublicKey = struct
- open Mirage_crypto_ec.Ed25519
-
- type t = pub
-
- let to_octets t = pub_to_octets t
-
- let of_octets t =
- pub_of_octets t |> function
- | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
- | Ok v -> Ok v
-
- let bin =
- let of_octets_exn t = of_octets t |> Result.get_ok in
- Bin.map (Bin.bytes 32) of_octets_exn to_octets
-
- let of_b32 s =
- let* octets = B32.decode s in
- let* pub = of_octets octets in
- Ok pub
-
- let to_b32 t = B32.encode (to_octets t)
- let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
-
- let caqti =
- Caqti_type.custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> of_octets v)
- Caqti_type.octets
-end
-
-module EddsaPrivateKey = struct
- (* EdDSA and ECDHE public keys always point on Curve25519
- and represented using the standard 256 bits Ed25519 compact format,
- converted to Crockford Base32. *)
- open Mirage_crypto_ec.Ed25519
-
- type t = priv
-
- let pub_of_priv = pub_of_priv
- let to_octets t = priv_to_octets t
-
- let of_octets t =
- priv_of_octets t |> function
- | Error err ->
- let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in
- Error err
- | Ok v -> Ok v
-
- let bin =
- let of_octets_exn t = of_octets t |> Result.get_ok in
- Bin.map (Bin.bytes 32) of_octets_exn to_octets
-
- let jsont =
- let of_b32 s =
- let* octets = B32.decode s in
- of_octets octets
- in
- let to_b32 t = B32.encode (to_octets t) in
- Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
-end
-
-module EddsaSignature : sig
- type t
-
- val sign : key:EddsaPrivateKey.t -> string -> t
-
- (* Ok () on verification success *)
- val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result
- val to_octets : t -> string
- val of_octets : string -> (t, string) result
- val jsont : t Jsont.t
- val bin : t Bin.t
- val caqti : t Caqti_type.t
-end = struct
- (* transmitted as 64-bytes base32
- binary-encoded objects with just the R and S values *)
- type t = string
-
- (* mirage_crypto:
- "The result is the concatenation of r and s, as specified in RFC 8032." *)
- let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s
-
- let verify ~key s ~msg =
- let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in
- match b with
- | false -> Error "EddsaSignature verification: invalid signature"
- | true -> Ok ()
-
- let to_octets t = t
-
- let check_size t =
- match String.length t = 64 with
- | false -> Error "EddsaSignature of_octets: data is not 64 bytes."
- | true -> Ok ()
-
- let of_octets v =
- let+ () = check_size v in
- v
-
- let bin =
- let of_octets_exn t = of_octets t |> Result.get_ok in
- Bin.map (Bin.bytes 64) of_octets_exn to_octets
-
- let jsont =
- let of_b32 s =
- let* t = B32.decode s in
- of_octets t
- in
- let to_b32 = B32.encode in
- Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
-
- let caqti =
- Caqti_type.custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun s -> of_octets s)
- Caqti_type.octets
-end
-
-module RsaPublicKey = struct
- open Mirage_crypto_pk
-
- type t = Rsa.pub
-
- let to_octets = Binary_format_rsa.pub_to_octets
- let of_octets = Binary_format_rsa.pub_of_octets
-
- let jsont =
- let of_b32 s =
- let* s = B32.decode s in
- let+ v = of_octets s in
- v
- in
- let to_b32 t = B32.encode (to_octets t) in
- Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
-
- let caqti : t Caqti_type.t =
- Caqti_type.custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> of_octets v)
- Caqti_type.octets
-end
-
-module RsaPrivateKey = struct
- open Mirage_crypto_pk.Rsa
-
- type t = priv
-
- let generate ~bits () =
- let priv = generate ~bits () in
- let pub = pub_of_priv priv in
- (priv, pub)
-
- let pub_of_priv = pub_of_priv
- let of_octets = Binary_format_rsa.priv_of_octets
- let to_octets = Binary_format_rsa.priv_to_octets
-
- let jsont =
- let of_b32 s =
- let* s = B32.decode s in
- let+ v = of_octets s in
- v
- in
- let to_b32 t = B32.encode (to_octets t) in
- Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
-end
-
-module RsaSignature : sig
- type t
-
- val jsont : t Jsont.t
-end = struct
- type t = string
-
- let jsont =
- let of_b32 s = B32.decode s in
- let to_b32 t = B32.encode t in
- Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
-end
-
-(* some type aliases, just for prettier .mli *)
-type eddsa_priv = EddsaPrivateKey.t
-type eddsa_pub = EddsaPublicKey.t
-type eddsa_sig = EddsaSignature.t
-type rsa_priv = RsaPrivateKey.t
-type rsa_pub = RsaPublicKey.t
-type rsa_sig = RsaSignature.t
-type denom_hash = Hash.DenominationHash.t
-
-(* WIP *)
-module FDH_RSA = struct
- open Mirage_crypto_pk
-
- module Kdf = struct
- module XTR = Hkdf.Make (Digestif.SHA512)
- module PRF = Hkdf.Make (Digestif.SHA256)
-
- let kdf =
- fun ~xts ~ikm ~ctx ~len ->
- let prk = XTR.extract ~salt:xts ikm in
- let okm = PRF.expand ~prk ~info:ctx len in
- okm
-
- let kdf_mod_n ~n ~xts ~ikm ~ctx =
- let nbits = Z.numbits n in
- let len = ((nbits - 1) / 8) + 1 in
- assert (8 * len = nbits);
- let rec go ctr =
- (* cat ctx ctr_be *)
- let ctx =
- let ctx_len = String.length ctx in
- let b = Bytes.create (ctx_len + 2) in
- Bytes.blit_string ctx 0 b 0 ctx_len;
- Bytes.set_uint16_be b ctx_len ctr;
- Bytes.unsafe_to_string b
- in
- let okm = kdf ~xts ~ikm ~ctx ~len in
- assert (String.length okm = len);
- let r = Z_extra.of_octets_be okm in
- if Z.gt r n then go (succ ctr) else r
- in
- go 0
- end
-
- let gcd_validate r n =
- match Z.equal (Z.gcd r n) Z.one with
- | true -> ()
- | false -> Fmt.failwith "RSA key is malicious"
-
- let rsa_full_domain_hash pub msg =
- let xts = RsaPublicKey.to_octets pub in
- let ctx = "RSA-FDA FTpsW!" in
- let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:msg ~ctx in
- gcd_validate r pub.n; r
-
- let rsa_blinding_key_derive (pub : RsaPublicKey.t) bks =
- let xts = "Blinding KDF extractor HMAC key" in
- let ctx = "Blinding KDF" in
- let r = Kdf.kdf_mod_n ~n:pub.n ~xts ~ikm:bks ~ctx in
- gcd_validate r pub.n; r
-
- let rsa_blind pub ~bks ~msg =
- let data = rsa_full_domain_hash pub msg in
- let bkey = rsa_blinding_key_derive pub bks in
- (* can we just use [powm] here instead? *)
- let r_e = Z.powm_sec bkey pub.e pub.n in
- let data_r_e = Z.rem (Z.mul data r_e) pub.n in
- Z_extra.to_octets_be data_r_e
-
- (* -- WIP crypto -- *)
-
- (* TODO crypto
- not sure about signature scheme used by taler
- libgnunetutil crypto_rsa.c use "(flags raw)" => no padding *)
- (* decrypt <=> sign *)
- let rsa_sign_z priv r =
- let data = Z_extra.to_octets_be r in
- Rsa.decrypt ~crt_hardening:true ~key:priv data
-
- (* TODO crypto
- look into mirage-crypto for this
- use Eqaf for constant time string compare *)
- let rsa_verify_z pub r sig_ =
- let data = Z_extra.to_octets_be r in
- let sig_' = Rsa.encrypt ~key:pub data in
- match String.equal sig_ sig_' with
- | false -> Fmt.error "RSA signature verification failed"
- | true -> Ok ()
-
- let rsa_sign_fdh priv msg =
- let pub = Rsa.pub_of_priv priv in
- let r = rsa_full_domain_hash pub msg in
- rsa_sign_z priv r
-
- let rsa_unblind pub ~bks ~sig_ =
- let bkey = rsa_blinding_key_derive pub bks in
- let r_inv =
- try Z.invert bkey pub.n
- with Division_by_zero ->
- (* => gcd(r,n) <> 1, should be already checked for *)
- assert false
- in
- let ubsig = Z.rem (Z.mul sig_ r_inv) pub.n in
- ubsig
-
- let rsa_verify pub ~msg ~sig_ =
- let r = rsa_full_domain_hash pub msg in
- rsa_verify_z pub r sig_
-end
diff --git a/.jjconflict-side-1/src/denomination.ml b/.jjconflict-side-1/src/denomination.ml
deleted file mode 100644
index c8b8603e..00000000
--- a/.jjconflict-side-1/src/denomination.ml
+++ /dev/null
@@ -1,18 +0,0 @@
-open Crypto
-
-type t = {
- pub: rsa_pub;
- value: Amount.t;
- stamp_start: Timestamp.t;
- stamp_expire_withdraw: Timestamp.t;
- stamp_expire_deposit: Timestamp.t;
- stamp_expire_legal: Timestamp.t;
- fee_withdraw: Amount.t;
- fee_deposit: Amount.t;
- fee_refresh: Amount.t;
- fee_refund: Amount.t;
- age_mask: int;
- h_pub: denom_hash;
- master_sig: Signatures.DenominationKeyValidity.t;
- revoked_sig: Signatures.MasterDenominationKeyRevocation.t option;
-}
diff --git a/.jjconflict-side-1/src/devices.ml b/.jjconflict-side-1/src/devices.ml
deleted file mode 100644
index 1d3c702b..00000000
--- a/.jjconflict-side-1/src/devices.ml
+++ /dev/null
@@ -1,26 +0,0 @@
-type env = {
- caqti_switch: Caqti_miou.Switch.t;
- db_uri: Uri.t;
-}
-
-let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
- let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
- Vif.Device.v ~name:"db_connection" ~finally []
- @@ fun { caqti_switch; db_uri } ->
- match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
- | Error err ->
- Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
- | Ok conn -> (
- match Pg.preflight conn with
- | Error err ->
- Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
- | Ok () ->
- Logs.info (fun m -> m "database connection initialized");
- conn)
-
-let keys =
- let finally _key = () in
- Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ]
- @@ fun (module Conn : Pg.CONN) (_env : env) ->
- let sm : (module Keys.S) = (module Keys.Make (Conn)) in
- sm
diff --git a/.jjconflict-side-1/src/dune b/.jjconflict-side-1/src/dune
deleted file mode 100644
index 0a6fa0ea..00000000
--- a/.jjconflict-side-1/src/dune
+++ /dev/null
@@ -1,45 +0,0 @@
-(executable
- (public_name mte)
- (name mte)
- (modules mte)
- (libraries mte))
-
-(library
- (name mte)
- (wrapped false)
- (modules :standard \ mte b32)
- (libraries
- b32
- ;
- caqti
- caqti-miou
- caqti-miou.unix
- caqti-driver-pgx
- bin
- mirage-crypto
- kdf.hkdf
- digestif
- duration
- vif
- fmt
- jsont
- cohttp
- ptime
- logs
- logs.fmt
- logs.threaded
- fmt.tty))
-
-(library ; crockford base32
- (name b32)
- (modules b32)
- (libraries base32))
-
-(rule
- (target assets_crunch.ml)
- (deps
- (source_tree ../assets))
- (action
- (with-stdout-to
- %{null}
- (run ocaml-crunch -m plain ../assets -o %{target}))))
diff --git a/.jjconflict-side-1/src/hash.ml b/.jjconflict-side-1/src/hash.ml
deleted file mode 100644
index ef1f4e10..00000000
--- a/.jjconflict-side-1/src/hash.ml
+++ /dev/null
@@ -1,103 +0,0 @@
-open Digestif
-
-module type S = sig
- type t
-
- val bin : t Bin.t
- val caqti : t Caqti_type.t
- val jsont : t Jsont.t
- val hash : string -> t
- val of_octets : string -> t
- val to_octets : t -> string
- val of_b32 : B32.t -> (t, string) result
-end
-
-module H32 = struct
- type t = SHA256.t
-
- let hash s = SHA256.(digest_string s)
-
- let of_octets s =
- match SHA256.of_raw_string_opt s with
- | None -> Fmt.failwith "H32.of_octets failure"
- | Some t -> t
-
- let to_octets = SHA256.to_raw_string
- let of_b32 s = Result.map of_octets (B32.decode s)
-
- let bin =
- let open Bin in
- map (bytes 32) of_octets to_octets
-
- (* hashes are not b32 encoded in the database *)
- let caqti =
- let open Caqti_type in
- custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> Ok (of_octets v))
- octets
-
- let jsont =
- let enc v = B32.encode (to_octets v) in
- Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc
-end
-
-module H64 = struct
- type t = SHA512.t
-
- let hash s = SHA512.(digest_string s)
-
- let of_octets s =
- match SHA512.of_raw_string_opt s with
- | None -> Fmt.failwith "H64.of_octets failure"
- | Some t -> t
-
- let to_octets = SHA512.to_raw_string
- let of_b32 s = Result.map of_octets (B32.decode s)
-
- let bin =
- let open Bin in
- map (bytes 64) of_octets to_octets
-
- (* hashes are not b32 encoded in the database *)
- let caqti =
- let open Caqti_type in
- custom
- ~encode:(fun v -> Ok (to_octets v))
- ~decode:(fun v -> Ok (of_octets v))
- octets
-
- let jsont =
- let enc v = B32.encode (to_octets v) in
- Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc
-end
-
-(* C-terminated strings
- some strings need to be hashed with a '\0' termination char *)
-module Cstring = struct
- module H32 = struct
- include H32
-
- let hash s = hash (s ^ "\x00")
- end
-
- module H64 = struct
- include H64
-
- let hash s = hash (s ^ "\x00")
- end
-end
-
-(* TODO
- check which hash algorithm to use for each hash type *)
-module FullPaytoHash : S = H32
-module NormalizedPaytoHash : S = H32
-module DenominationHash : S = H64
-module PrivateContractHash : S = H64
-module ExtensionsPolicyHash : S = H64
-module MerchantWireHash : S = H64
-module AgeCommitmentHash : S = H64
-module BlindedCoinHash : S = H64
-module CoinPubHash : S = H64
-module OutputCommitmentHash : S = H64
-module HashPlanchetsP : S = H64
diff --git a/.jjconflict-side-1/src/headers.ml b/.jjconflict-side-1/src/headers.ml
deleted file mode 100644
index fd6ebfc7..00000000
--- a/.jjconflict-side-1/src/headers.ml
+++ /dev/null
@@ -1,44 +0,0 @@
-let accept_header_value =
- Fmt.str "%a"
- (Fmt.array ~sep:(Fmt.any ", ") Assets.Mimetype.pp)
- Assets.Mimetype.arr
-
-let avail_languages_header_value =
- Fmt.str "%a" (Fmt.array ~sep:(Fmt.any ", ") Fmt.string) Assets.Language.arr
-
-(* TODO Cohttp raises on invalid *)
-let select_mimetype headers =
- let opt = Vif.Headers.get headers "accept" in
- Cohttp.Accept.media_ranges opt
- |> Cohttp.Accept.qsort
- |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp m)
- |> function
- | None -> Assets.Mimetype.default
- | Some mime -> mime
-
-let select_language headers =
- let opt = Vif.Headers.get headers "accept-language" in
- Cohttp.Accept.languages opt
- |> Cohttp.Accept.qsort
- |> List.map snd
- |> List.find_map Assets.Language.of_cohttp
- |> function
- | None -> Assets.Language.default
- | Some lang -> lang
-
-let select_encoding headers =
- let opt = Vif.Headers.get headers "accept-encoding" in
- Cohttp.Accept.encodings opt
- |> Cohttp.Accept.qsort
- |> List.map snd
- |> List.find_map (function
- | Cohttp.Accept.Identity -> Some `Identity
- | Deflate -> Some `DEFLATE
- | Gzip -> Some `Gzip
- | AnyEncoding -> Some Assets.Assets_config.default_encoding
- | Encoding _ | Compress -> (* unsupported *) None)
- |> function
- | None -> None
- | Some `Identity -> None
- | Some `DEFLATE -> Some `DEFLATE
- | Some `Gzip -> Some `Gzip
diff --git a/.jjconflict-side-1/src/headers_lib.ml b/.jjconflict-side-1/src/headers_lib.ml
deleted file mode 100644
index e76a589a..00000000
--- a/.jjconflict-side-1/src/headers_lib.ml
+++ /dev/null
@@ -1,69 +0,0 @@
-module Etag = struct
- (* https://httpwg.org/specs/rfc9110.html#field.etag *)
-
- type t = {
- weak: bool;
- value: string;
- }
-
- let pp ppf { weak; value } =
- match weak with
- | false -> Fmt.pf ppf {|"%s"|} value
- | true -> Fmt.pf ppf {|W/"%s"|} value
-
- let to_field_string t = Fmt.str "%a" pp t
-
- let angstrom =
- let open Angstrom in
- let is_valid_char c =
- let n = Char.code c in
- (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
- in
- let quoted_string = char '"' *> take_while is_valid_char <* char '"' in
- lift2
- (fun weak value -> { weak; value })
- (option false (string "W/" *> return true))
- quoted_string
-
- let parse s =
- match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
- | Error _e -> Fmt.error "invalid etag: `%s`" s
- | Ok v -> Ok v
-end
-
-module If_none_match = struct
- type t =
- | Any
- | List of Etag.t list
-
- let pp ppf = function
- | Any -> Fmt.pf ppf {|*|}
- | List l -> Fmt.pf ppf {|%a|} (Fmt.list ~sep:(Fmt.any ", ") Etag.pp) l
-
- let angstrom =
- let open Angstrom in
- let ows = skip_while (function ' ' | '\t' -> true | _ -> false) in
- let comma = ows *> char ',' *> ows in
- (* A recipient MUST parse and ignore a reasonable number of empty list elements *)
- let etag_opt = Etag.angstrom >>| Option.some <|> return None in
- let etags =
- etag_opt >>= fun hd ->
- many (comma *> etag_opt) >>= fun tl ->
- let l = List.filter_map Fun.id (hd :: tl) in
- match l with [] -> fail "empty etag list" | l -> return (List l)
- in
- let any = char '*' *> return Any in
- any <|> etags
-
- let parse s =
- match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
- | Error _e -> Fmt.error "invalid if-none-match field: `%s`" s
- | Ok v -> Ok v
-
- let evaluate etag t =
- match t with
- | Any -> false
- | List l ->
- not
- @@ List.exists (fun e -> String.equal etag.Etag.value e.Etag.value) l
-end
diff --git a/.jjconflict-side-1/src/http_information.ml b/.jjconflict-side-1/src/http_information.ml
deleted file mode 100644
index 6c4068d9..00000000
--- a/.jjconflict-side-1/src/http_information.ml
+++ /dev/null
@@ -1,254 +0,0 @@
-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.ok 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
- Denomination.
- {
- 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 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 Keys : Keys.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 dn_l =
- (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
- Keys.get_denominations ()
- |>
- (* reverse chronological order *)
- List.sort (fun a b ->
- Stdlib.compare b.Denomination.stamp_start a.stamp_start)
- in
- let list_issue_date =
- match dn_l with
- | [] -> Timestamp.never
- | dn :: _ -> dn.Denomination.stamp_start
- in
- let denominations =
- (* if `?last_issue_date` query param does not exactly match the `stamp_start`
- of one of the denomination keys, all keys are returned *)
- let open Denomination in
- let l =
- match last_issue_date with
- | None -> dn_l
- | Some last_issue_date -> (
- match
- List.find_opt
- (fun v -> Timestamp.compare v.stamp_start last_issue_date = 0)
- dn_l
- with
- | None -> dn_l
- | Some _ ->
- List.filter
- (fun v ->
- Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
- dn_l)
- in
- List.map denomgroup_of_denomdata l
- in
-
- let signkeys =
- (*
- let now = Ptime_clock.now () |> Option.some in
- let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
- Keys.get_signkeys ()
- |> List.sort (fun a b ->
- let open Signkey in
- Stdlib.compare b.stamp_start a.stamp_start)
- |> List.map Api.SignKey.of_signkey
- in
-
- let exchange_pub =
- (* the eddsa pub key used to sign exchange_sig *)
- match signkeys with
- | [] -> Fmt.failwith "exchange has no active signkey"
- | sk :: _ -> sk.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 =
- dn_l
- |> List.map (fun dn -> dn.Denomination.master_sig)
- |> List.map Signatures.DenominationKeyValidity.to_octets
- |> String.concat ""
- |> Hash.H64.hash
- in
- let open Signatures.ExchangeKeySet in
- sign_f
- ~f:(Keys.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 keys = Vif.Server.device Devices.keys 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 keys ~last_issue_date in
- let s = Api.encode_exn jsont v in
- Ok s
- in
- Respond.result res req
diff --git a/.jjconflict-side-1/src/http_terms.ml b/.jjconflict-side-1/src/http_terms.ml
deleted file mode 100644
index 4dca972a..00000000
--- a/.jjconflict-side-1/src/http_terms.ml
+++ /dev/null
@@ -1,49 +0,0 @@
-(* /terms + /privacy *)
-
-let aux asset req _server _env =
- let etag = Assets.etag asset in
- let headers = Vif.Request.headers req in
- let has_matching_etag =
- match Vif.Headers.get headers "if-none-match" with
- | None -> Ok false
- | Some s ->
- Headers_lib.If_none_match.parse s
- |> Result.map (Headers_lib.If_none_match.evaluate etag)
- in
- match has_matching_etag with
- | Error e -> Respond.bad_request ~hint:e req
- | Ok true -> Respond.not_modified ()
- | Ok false ->
- let mime = Headers.select_mimetype headers in
- let lang = Headers.select_language headers in
- let compression = Headers.select_encoding headers in
- let data = Assets.get_content ~mime ~lang asset in
- (* -- *)
- let open Vif.Response in
- let open Syntax in
- let* () = with_string ?compression req data in
- let* () =
- let etag_field_value = Headers_lib.Etag.to_field_string etag in
- add ~field:"etag" etag_field_value
- in
- let* () =
- add ~field:"taler-terms-version"
- Assets.Assets_config.terms_legal_version
- in
- let* () =
- add ~field:"avail-languages" Headers.avail_languages_header_value
- in
- let* () =
- let content_type = Fmt.str "%a" Assets.Mimetype.pp mime in
- add ~field:"content-type" content_type
- in
- let* () = add ~field:"content-language" lang in
- respond `OK
-
-let terms req _server _env =
- Logs.info (fun m -> m "GET /terms");
- aux Assets.Terms req _server _env
-
-let privacy req _server _env =
- Logs.info (fun m -> m "GET /privacy");
- aux Assets.Privacy req _server _env
diff --git a/.jjconflict-side-1/src/keys.mli b/.jjconflict-side-1/src/keys.mli
deleted file mode 100644
index cedff889..00000000
--- a/.jjconflict-side-1/src/keys.mli
+++ /dev/null
@@ -1,45 +0,0 @@
-module type S = sig
- open Crypto
-
- val sm_pubkey : eddsa_pub
- val sign_with_sm_key : string -> eddsa_sig
- val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
- val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
- val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
-
- val verify_with_signkey :
- pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
-
- val get_signkeys : unit -> Signkey.t list
- val get_denominations : unit -> Denomination.t list
- val get_future_signkeys : unit -> Api.FutureSignKey.t list
- val get_future_denominations : unit -> Api.FutureDenom.t list
- val find_signkey : eddsa_pub -> Signkey.t option
- val find_denomination : denom_hash -> Denomination.t option
- val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
- val find_future_denomination : denom_hash -> Api.FutureDenom.t option
-
- val certify_future_signkey :
- eddsa_pub ->
- master_sig:Signatures.ExchangeSigningKeyValidity.t ->
- (unit, string) result
-
- val certify_future_denomination :
- denom_hash ->
- master_sig:Signatures.DenominationKeyValidity.t ->
- (unit, string) result
-
- val revoke_signkey :
- eddsa_pub ->
- Signatures.MasterSigningKeyRevocation.t ->
- (unit, string) result
-
- val revoke_denomination :
- denom_hash ->
- Signatures.MasterDenominationKeyRevocation.t ->
- (unit, string) result
-
- val save : unit -> (unit, string) result
-end
-
-module Make (_ : Pg.CONN) : S
diff --git a/.jjconflict-side-1/src/mte.ml b/.jjconflict-side-1/src/mte.ml
deleted file mode 100644
index 77f07de8..00000000
--- a/.jjconflict-side-1/src/mte.ml
+++ /dev/null
@@ -1,83 +0,0 @@
-(* MTE - the MirageOS Taler Exchange
- Copyright (C) 2025 Olivier Pierre
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU Affero General Public License as published by
- the Free Software Foundation, version 3.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Affero General Public License for more details.
-
- You should have received a copy of the GNU Affero General Public License
- along with this program. If not, see . *)
-
-let hello req _server _env =
- let open Vif.Response in
- let open Syntax in
- let* () = with_string req "Hello~~\n" in
- let* () = add ~field:"content-type" "text/plain" in
- respond `OK
-
-let routes =
- let open Vif.Uri in
- let open Vif.Route in
- let get path = get (path /?? any) in
- let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in
- let v s = rel / s in
- let tos =
- [
- get rel --> hello;
- get (v "terms") --> Http_terms.terms;
- get (v "privacy") --> Http_terms.privacy;
- ]
- in
- let status_info =
- [
- get (v "seed") --> Http_information.seed;
- get (v "config") --> Http_information.config;
- get (v "keys") --> Http_information.keys;
- ]
- in
- let management =
- let open Http_management in
- let v s = v "management" / s in
- [
- get (v "keys") --> Keys_get.f;
- post (v "keys") Keys_post.jsont --> Keys_post.f;
- post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
- --> Denom_revoke.f;
- post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont
- --> Signkey_revoke.f;
- post (v "auditors") Auditors.jsont --> Auditors.f;
- post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont
- --> Auditors_disable.f;
- post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f;
- post (v "global-fees") Global_fees.jsont --> Global_fees.f;
- post (v "wire") Wire.jsont --> Wire.f;
- post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f;
- post (v "drain") Drain.jsont --> Drain.f;
- post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f;
- post (v "partners") Partners.jsont --> Partners.f;
- ]
- in
- tos @ status_info @ management
-
-let () =
- Util.Log_reporter.setup ();
- let cfg =
- let port = Config.Exchange.port in
- let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
- Vif.config ~reporter:Util.Log_reporter.reporter sockaddr
- in
- Miou_unix.run @@ fun () ->
- Caqti_miou.Switch.run @@ fun caqti_switch ->
- let env : Devices.env =
- { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
- in
- let devices = Vif.Devices.[ Devices.db_connection; Devices.keys ] in
- let middlewares = Vif.Middlewares.[] in
- Logs.info (fun m ->
- m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
- Vif.run ~cfg ~devices ~middlewares routes env
diff --git a/.jjconflict-side-1/src/parse_config.ml b/.jjconflict-side-1/src/parse_config.ml
deleted file mode 100644
index 86254830..00000000
--- a/.jjconflict-side-1/src/parse_config.ml
+++ /dev/null
@@ -1,232 +0,0 @@
-(* rudimentary configuration file parser (INI-like)
- https://docs.taler.net/manpages/taler-exchange.conf.5.html
-
- do not support "$"-path expansion *)
-
-open Angstrom
-
-type item = {
- key: string;
- value: string;
-}
-
-type section = {
- header: string;
- items: item list;
-}
-
-let fail fmt =
- let k _ppf = exit 1 in
- Fmt.kpf k Fmt.stderr ("Configuration failure: " ^^ fmt ^^ ".@.")
-
-let is_eol = function '\n' | '\r' -> true | _ -> false
-let is_whitespace = function ' ' | '\t' -> true | _ -> false
-let blanks = skip_while is_whitespace
-
-module Config_section = struct
- type t =
- | Blank
- | Comment of string
- | Header of string
- | Item of item
-
- let id =
- let ident_char = function
- | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
- | _ -> false
- in
- take_while1 ident_char >>| String.lowercase_ascii
-
- let line = take_till is_eol <* end_of_line
- let blank_line = blanks <* end_of_line >>| fun () -> Blank
- let comment = blanks *> (char '#' <|> char '%') *> line >>| fun s -> Comment s
-
- let header =
- blanks *> char '[' *> id <* char ']' <* blanks <* end_of_line >>| fun s ->
- Header s
-
- let item_value =
- let unquoted_value =
- take_while1 (fun c -> not (is_whitespace c || is_eol c))
- <* blanks
- <* end_of_line
- in
- let quoted_value =
- char '"' *> take_till is_eol <* end_of_line >>= fun s ->
- match String.ends_with ~suffix:"\"" s && s <> "\"" with
- | false -> fail "invalid quoted value"
- | true ->
- let value = String.sub s 0 (String.length s - 1) in
- return value
- in
- quoted_value <|> unquoted_value
-
- let item =
- lift2
- (fun key value -> Item { key; value })
- id
- (blanks *> char '=' *> blanks *> item_value)
-
- let config =
- many (choice [ blank_line; comment; header; item ]) <* end_of_input
-
- let fold_sections l =
- let rec loop section_l item_l l =
- match l with
- | [] ->
- if List.is_empty item_l then section_l
- else fail "invalid configuration structure"
- | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
- | Item item :: tl -> loop section_l (item :: item_l) tl
- | Header header :: tl ->
- let section = { header; items= item_l } in
- loop (section :: section_l) [] tl
- in
- loop [] [] (List.rev l)
-
- let parse s =
- match parse_string ~consume:All config s with
- | Error msg -> fail "parse error `%s`" msg
- | Ok v -> fold_sections v
-end
-
-module Config_duration = struct
- type duration_element = {
- number: int;
- dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
- }
-
- let integer =
- take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
- match int_of_string_opt s with
- | None -> fail "expected integer, got `%s`" s
- | Some i -> return i
-
- let duration_element =
- let number = blanks *> integer in
- let dunit =
- blanks *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
- >>= function
- | "year" | "years" -> return `Year
- | "week" | "weeks" -> return `Week
- | "day" | "days" -> return `Day
- | "hour" | "hours" -> return `Hour
- | "minute" | "minutes" -> return `Minute
- | "second" | "seconds" | "s" -> return `Second
- | s -> fail "expected a duration unit, got `%s`" s
- in
- lift2 (fun number dunit -> { number; dunit }) number dunit
-
- let duration = many1 duration_element <* end_of_input
-
- (* TODO put this in Time.Relative *)
- let dunit_to_seconds u =
- let rec f = function
- | `Year -> 365 * f `Day
- | `Week -> 7 * f `Day
- | `Day -> 24 * f `Hour
- | `Hour -> 60 * f `Minute
- | `Minute -> 60 * f `Second
- | `Second -> 1
- in
- f u
-
- let to_time_span t =
- List.fold_left
- (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
- 0 t
- |> Int64.of_int
- |> Time.Relative.of_s
-
- let parse s : duration_element list =
- match parse_string ~consume:All duration s with
- | Error msg -> fail "duration parse error `%s`" msg
- | Ok v -> v
-end
-
-let unwrap = function Error e -> fail "`%s`." e | Ok v -> v
-
-let get_opt t ~section ~field =
- match List.find_opt (fun v -> v.header = section) t with
- | None -> None
- | Some v -> (
- match List.find_opt (fun item -> item.key = field) v.items with
- | None -> None
- | Some item -> Some item.value)
-
-let get t ~section ~field =
- match get_opt t ~section ~field with
- | None -> fail "option `[%s].%s` not found" section field
- | Some v -> v
-
-let int s =
- match int_of_string_opt s with
- | None -> fail "expected int value, got `%s`" s
- | Some v -> v
-
-let float s =
- match float_of_string_opt s with
- | None -> fail "expected float value, got `%s`" s
- | Some v -> v
-
-let const_value a b =
- match a = b with false -> fail "unexpected value `%s`" b | true -> a
-
-let yes_no = function
- | "NO" -> `NO
- | "YES" -> `YES
- | s -> fail "expected `YES`/`NO` value, got `%s`" s
-
-let uri s = Uri.of_string s
-let amount s = s |> Amount.of_string |> unwrap
-let duration s = Config_duration.(s |> parse |> to_time_span)
-
-let ed25519 s =
- s
- |> B32.decode
- |> unwrap
- |> Mirage_crypto_ec.Ed25519.pub_of_octets
- |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
- |> unwrap
-
-let etag s =
- match Headers_lib.Etag.parse s with
- | Ok etag -> etag
- | Error e -> (
- (* retry with quotes if needed *)
- match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with
- | Ok etag -> etag
- | Error _ -> fail "could not parse etag `%s`: %s" s e)
-
-(* TODO
- move to another module
- can we type the json as a Int_map directly? *)
-module Alt_unit_names = struct
- open Syntax
- module String_map = Map.Make (String)
-
- let string_map_jsont = Jsont.Object.as_string_map Jsont.string
-
- let decode s =
- let* string_map = Jsont_bytesrw.decode_string string_map_jsont s in
- let l = String_map.to_list string_map in
- let* l =
- list_map
- (fun (k, v) ->
- match int_of_string_opt k with
- | None -> Error "alt_unit_names has a non-integer key"
- | Some k -> Ok (k, v))
- l
- in
- match List.find_opt (fun (i, _) -> i = 0) l with
- | None -> Error "alt_unit_names with no entry for base value \"0\""
- | Some _ -> Ok l
-
- let encode l =
- let l = List.map (fun (k, v) -> (string_of_int k, v)) l in
- let string_map = String_map.of_list l in
- let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in
- s
-
- let encode_exn l = encode l |> Result.get_ok
-end
diff --git a/.jjconflict-side-1/src/pg.ml b/.jjconflict-side-1/src/pg.ml
deleted file mode 100644
index fa9abe10..00000000
--- a/.jjconflict-side-1/src/pg.ml
+++ /dev/null
@@ -1,364 +0,0 @@
-(* TODO
- check signed/unsigned ints
- check endianness
- can we avoid amount tuple boilerplate?
- clean up caqti error type
-
- transaction
-
- GNU Taler use of db-events?
- it seems caqti/pgx does not support it *)
-
-module type CONN = Caqti_miou.CONNECTION
-
-module Caqti_type = struct
- include Caqti_type
- include Pg_type
- include Caqti_request.Infix
-end
-
-open Crypto
-open Api
-
-let preflight =
- let l =
- List.map
- Caqti_type.(unit ->. unit)
- [
- "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL \
- SERIALIZABLE;";
- "SET enable_sort=OFF;";
- "SET enable_seqscan=OFF;";
- "SET enable_mergejoin=OFF;";
- "SET search_path TO exchange;";
- ]
- in
- fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l
-
-let find_signkey =
- let find_signkey =
- Caqti_type.(eddsa_pub ->? signkey_data)
- "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
- esk.expire_legal, esk.master_sig, skr.master_sig FROM \
- exchange_sign_keys AS esk LEFT JOIN signkey_revocations AS skr ON \
- esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1"
- in
- fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
- Conn.find_opt find_signkey exchange_pub
-
-let get_active_signkeys =
- let get_active_signkeys =
- Caqti_type.(time ->* signkey_data)
- "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
- esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \
- WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \
- signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)"
- in
- fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now
-
-(* note: does not update revocation *)
-let insert_signkey =
- let insert_signkey =
- Caqti_type.(signkey_data ->. unit)
- "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
- expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_signkey v
-
-let find_denom =
- let find_denom =
- Caqti_type.(denom_hash ->? denom_data)
- "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
- dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
- (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
- dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
- dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
- = dnr.denominations_serial WHERE dn.denom_pub_hash=$1"
- in
- fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub
-
-let get_denominations =
- let get_denominations =
- Caqti_type.(unit ->* denom_data)
- "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
- dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
- (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
- dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
- dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
- = dnr.denominations_serial"
- in
- fun (module Conn : CONN) -> Conn.collect_list get_denominations ()
-
-(* note: does not update revocation *)
-let insert_denom =
- let insert_denom =
- Caqti_type.(denom_data ->. unit)
- "INSERT INTO denominations (denom_pub, coin, valid_from, \
- expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \
- fee_deposit, fee_refresh, fee_refund, age_mask, denom_pub_hash, \
- master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \
- ($12,$13), ($14,$15), $16, $17, $18)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_denom v
-
-let insert_denomination_revocation =
- let denomination_revocation_insert =
- let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in
- Caqti_type.(t2 denom_hash master_sig ->. unit)
- "INSERT INTO denomination_revocations (denominations_serial, master_sig) \
- SELECT denominations_serial, $2 FROM denominations WHERE \
- denom_pub_hash=$1"
- in
- fun (module Conn : CONN) h_denom_pub master_sig ->
- Conn.exec denomination_revocation_insert (h_denom_pub, master_sig)
-
-let insert_signkey_revocation =
- let signkey_revocation_insert =
- let master_sig = Signatures.MasterSigningKeyRevocation.caqti in
- Caqti_type.(t2 eddsa_pub master_sig ->. unit)
- "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \
- esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1"
- in
- fun (module Conn : CONN) exchange_pub master_sig ->
- Conn.exec signkey_revocation_insert (exchange_pub, master_sig)
-
-let get_auditor_timestamp =
- let get_auditor_timestamp =
- Caqti_type.(eddsa_pub ->? time)
- "SELECT last_change FROM auditors WHERE auditor_pub=$1"
- in
- fun (module Conn : CONN) auditor_pub ->
- Conn.find_opt get_auditor_timestamp auditor_pub
-
-let insert_auditor =
- let insert_auditor =
- Caqti_type.(t4 eddsa_pub string string time ->. unit)
- "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
- is_active, last_change) VALUES ($1, $2, $3, true, $4)"
- in
- fun (module Conn : CONN)
- AuditorSetupMessage.
- { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
- ->
- Conn.exec insert_auditor
- (auditor_pub, auditor_name, auditor_url, validity_start)
-
-let update_auditor =
- let update_auditor =
- Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
- "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
- last_change=$5 WHERE auditor_pub=$1"
- in
- fun (module Conn : CONN)
- AuditorSetupMessage.
- { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
- ->
- Conn.exec update_auditor
- (auditor_pub, auditor_url, auditor_name, true, validity_start)
-
-let disable_auditor =
- let update_auditor =
- Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
- "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
- last_change=$5 WHERE auditor_pub=$1"
- in
- fun (module Conn : CONN) ~auditor_pub ~change_date ->
- Conn.exec update_auditor (auditor_pub, "", "", false, change_date)
-
-let insert_auditor_denom_sig =
- let insert_auditor_denom_sig =
- let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
- Caqti_type.(t3 eddsa_pub denom_hash auditor_sig ->. unit)
- "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \
- INSERT INTO auditor_denom_sigs (auditor_uuid, denominations_serial, \
- auditor_sig) SELECT ax.auditor_uuid, denominations_serial, $3 FROM \
- denominations CROSS JOIN ax WHERE denom_pub_hash=$2 ON CONFLICT DO \
- NOTHING"
- in
- fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig ->
- Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig)
-
-(* todo auditors
- maybe check that url and name are unique/same for each auditor_pub
- and do the ht logic out of pg.ml? *)
-(* this does not return auditors that are not auditing any denom *)
-let get_auditor_keys =
- let get_auditor_keys =
- let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
- Caqti_type.(unit ->* t5 eddsa_pub string string denom_hash auditor_sig)
- "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \
- ads.auditor_sig FROM auditor_denom_sigs AS ads JOIN auditors AS a USING \
- (auditor_uuid) JOIN denominations AS dn USING (denominations_serial) \
- WHERE a.is_active"
- in
- fun (module Conn : CONN) ->
- let open Syntax in
- let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in
- let ht = Hashtbl.create 0xff in
- List.iter
- (fun (pub, url, name, denom_pub_h, auditor_sig) ->
- let k = (pub, url, name) in
- match Hashtbl.find_opt ht k with
- | None -> Hashtbl.replace ht k [ (denom_pub_h, auditor_sig) ]
- | Some l -> Hashtbl.replace ht k ((denom_pub_h, auditor_sig) :: l))
- l;
- let l = Hashtbl.to_seq ht |> List.of_seq in
- let l =
- List.map
- (fun ((auditor_pub, auditor_url, auditor_name), auditor_denoms) ->
- let denomination_keys =
- List.map
- (fun (denom_pub_h, auditor_sig) ->
- AuditorDenominationKey.{ denom_pub_h; auditor_sig })
- auditor_denoms
- in
- AuditorKeys.
- { auditor_pub; auditor_url; auditor_name; denomination_keys })
- l
- in
- Ok l
-
-let insert_wire_fee =
- let insert_wire_fee =
- let master_sig = Signatures.MasterWireFee.caqti in
- Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit)
- "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \
- closing_fee, master_sig) VALUES ($1, $2, $3, ($4,$5), ($6,$7), $8)"
- in
- fun (module Conn : CONN)
- WireFeeSetupMessage.
- {
- wire_method;
- master_sig_wire;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- }
- ->
- Conn.exec insert_wire_fee
- (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire)
-
-let get_wire_fees_by_time =
- let get_wire_fee_by_time =
- Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee)
- "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
- FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \
- $3"
- in
- fun (module Conn : CONN) ~wire_method ~start_date ~end_date ->
- Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date)
-
-let get_wire_fees =
- let get_wire_fees =
- Caqti_type.(string ->* aggregate_transfer_fee)
- "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
- FROM wire_fee WHERE wire_method=$1"
- in
- fun (module Conn : CONN) ~wire_method ->
- Conn.collect_list get_wire_fees wire_method
-
-let get_global_fees =
- let get_global_fees =
- Caqti_type.(time ->* global_fee)
- "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
- (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
- master_sig FROM global_fee WHERE start_date >= $1"
- in
- fun (module Conn : CONN) ~start_date ->
- Conn.collect_list get_global_fees start_date
-
-let get_global_fees_by_time =
- let get_global_fees_by_time =
- Caqti_type.(t2 time time ->* global_fee)
- "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
- (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
- master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2"
- in
- fun (module Conn : CONN) ~start_date ~end_date ->
- Conn.collect_list get_global_fees_by_time (start_date, end_date)
-
-let insert_global_fees =
- let insert_global_fees =
- Caqti_type.(global_fee ->. unit)
- "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
- purse_fee, history_expiration, purse_account_limit, purse_timeout, \
- master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
- $12)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_global_fees v
-
-let get_wire_timestamp =
- let get_wire_timestamp =
- Caqti_type.(payto_uri ->? time)
- "SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
- in
- fun (module Conn : CONN) ~payto_uri ->
- Conn.find_opt get_wire_timestamp payto_uri
-
-let insert_wire =
- let insert_wire =
- Caqti_type.(t3 exchange_wire_account bool time ->. unit)
- "INSERT INTO wire_accounts (payto_uri, conversion_url, \
- credit_restrictions, debit_restrictions, master_sig, bank_label, \
- priority, is_active, last_change) VALUES \
- ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)"
- in
- fun (module Conn : CONN) ~last_change v ->
- let is_active = true in
- Conn.exec insert_wire (v, is_active, last_change)
-
-let update_wire =
- let update_wire =
- Caqti_type.(t3 exchange_wire_account bool time ->. unit)
- "UPDATE wire_accounts SET conversion_url=$2, \
- debit_restrictions=$3::TEXT::JSONB, \
- credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
- priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
- in
- fun (module Conn : CONN) ~is_active ~last_change v ->
- Conn.exec update_wire (v, is_active, last_change)
-
-let disable_wire =
- let disable_wire =
- Caqti_type.(t2 payto_uri time ->. unit)
- "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \
- credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \
- priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1"
- in
- fun (module Conn : CONN) ~payto_uri ~validity_end ->
- Conn.exec disable_wire (payto_uri, validity_end)
-
-let get_wire_accounts =
- let get_wire_accounts =
- Caqti_type.(unit ->* exchange_wire_account)
- "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
- credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
- wire_accounts WHERE is_active"
- in
- fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts ()
-
-let insert_drain_profit =
- let insert_drain_profit =
- Caqti_type.(drain_profit_message ->. unit)
- "INSERT INTO profit_drains (wtid, account_section, payto_uri, \
- trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v
-
-let insert_aml_officer =
- let exchange_do_insert_aml_officer =
- Caqti_type.(aml_officer_setup ->! time)
- "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \
- $4, $5, $6)"
- in
- fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v
-
-let insert_partner =
- let insert_partner =
- Caqti_type.(exchange_partner_setup ->. unit)
- "INSERT INTO partners (partner_master_pub, start_date, end_date, \
- wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \
- $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING"
- in
- fun (module Conn : CONN) v -> Conn.exec insert_partner v
diff --git a/.jjconflict-side-1/src/pg_type.ml b/.jjconflict-side-1/src/pg_type.ml
deleted file mode 100644
index 40fb5826..00000000
--- a/.jjconflict-side-1/src/pg_type.ml
+++ /dev/null
@@ -1,360 +0,0 @@
-(* this module defines caqti encoding/decodings *)
-open Caqti_type
-open Crypto
-open Api
-
-let amount : Amount.t t =
- let open Amount in
- custom
- ~encode:(fun amount -> Ok (amount.value, amount.fraction))
- ~decode:(fun (value, fraction) ->
- Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
- (t2 int64 int32)
-
-(* we want to use int64 timestamps,
- not postgresql built-in timestamp type *)
-let ptime : unit t = Caqti_type.unit
-let time = Timestamp.caqti
-let time_span = Time.Relative.caqti
-let age_mask : int t = Caqti_type.int
-let rsa_pub = RsaPublicKey.caqti
-let eddsa_pub = EddsaPublicKey.caqti
-let eddsa_sig = EddsaSignature.caqti
-
-(* todo: enum type for wire_method? *)
-let wire_method = Caqti_type.string
-let payto_uri = Caqti_type.string
-let b32 = B32.caqti
-
-include struct
- (* alias for hash *)
- open Hash
-
- let fullpayto_hash = FullPaytoHash.caqti
- let nomalizaedpayto_hash = NormalizedPaytoHash.caqti
- let denom_hash = DenominationHash.caqti
- let privatecontract_hash = PrivateContractHash.caqti
- let extensionspolicy_hash = ExtensionsPolicyHash.caqti
- let merchantwire_hash = MerchantWireHash.caqti
- let agecommitment_hash = AgeCommitmentHash.caqti
- let blindedcoin_hash = BlindedCoinHash.caqti
- let coinpub_hash = CoinPubHash.caqti
- let outputcommitment_hash = OutputCommitmentHash.caqti
- let planchets_hash = HashPlanchetsP.caqti
-end
-
-let signkey_data =
- let master_sig = Signatures.ExchangeSigningKeyValidity.caqti in
- let revoked_sig = option Signatures.MasterSigningKeyRevocation.caqti in
- custom
- ~encode:(fun
- Signkey.
- { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
- ->
- Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig))
- ~decode:(fun
- (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig) ->
- Ok { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig })
- (t6 eddsa_pub time time time master_sig revoked_sig)
-
-let denom_data =
- let master_sig = Signatures.DenominationKeyValidity.caqti in
- let revoked_sig = option Signatures.MasterDenominationKeyRevocation.caqti in
- custom
- ~encode:(fun
- Denomination.
- {
- 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;
- }
- ->
- Ok
- ( 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) ))
- ~decode:(fun
- ( 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) )
- ->
- Ok
- {
- 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;
- })
- (t12 rsa_pub amount time time time time amount amount amount amount int
- (t3 denom_hash master_sig revoked_sig))
-
-let account_restrictions =
- custom
- ~encode:(fun l -> Api.encode (Jsont.list AccountRestriction.jsont) l)
- ~decode:(fun s -> Api.decode (Jsont.list AccountRestriction.jsont) s)
- string
-
-let global_fee =
- let master_sig = Signatures.GlobalFees.caqti in
- custom
- ~encode:(fun
- GlobalFees.
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- }
- ->
- Ok
- ( start_date,
- end_date,
- history_fee,
- account_fee,
- purse_fee,
- history_expiration,
- purse_account_limit,
- purse_timeout,
- master_sig ))
- ~decode:(fun
- ( start_date,
- end_date,
- history_fee,
- account_fee,
- purse_fee,
- history_expiration,
- purse_account_limit,
- purse_timeout,
- master_sig )
- ->
- Ok
- {
- start_date;
- end_date;
- history_fee;
- account_fee;
- purse_fee;
- history_expiration;
- purse_account_limit;
- purse_timeout;
- master_sig;
- })
- Caqti_type.(
- t9 time time amount amount amount time_span int32 time_span master_sig)
-
-let aggregate_transfer_fee =
- let master_sig = Signatures.MasterWireFee.caqti in
- Caqti_type.custom
- ~encode:(fun
- AggregateTransferFee.
- { wire_fee; closing_fee; start_date; end_date; sig_ }
- -> Ok (wire_fee, closing_fee, start_date, end_date, sig_))
- ~decode:(fun (wire_fee, closing_fee, start_date, end_date, sig_) ->
- Ok
- AggregateTransferFee.
- { wire_fee; closing_fee; start_date; end_date; sig_ })
- Caqti_type.(t5 amount amount time time master_sig)
-
-let exchange_wire_account =
- let master_sig = Signatures.MasterWireDetails.caqti in
- Caqti_type.custom
- ~encode:(fun
- ExchangeWireAccount.
- {
- payto_uri;
- conversion_url;
- debit_restrictions;
- credit_restrictions;
- master_sig;
- bank_label;
- priority;
- }
- ->
- Ok
- ( payto_uri,
- conversion_url,
- debit_restrictions,
- credit_restrictions,
- master_sig,
- bank_label,
- priority ))
- ~decode:(fun
- ( payto_uri,
- conversion_url,
- debit_restrictions,
- credit_restrictions,
- master_sig,
- bank_label,
- priority )
- ->
- Ok
- {
- payto_uri;
- conversion_url;
- debit_restrictions;
- credit_restrictions;
- master_sig;
- bank_label;
- priority;
- })
- Caqti_type.(
- t7 payto_uri (option string) account_restrictions account_restrictions
- master_sig (option string) (option int))
-
-let drain_profit_message =
- let master_sig = Signatures.MasterDrainProfit.caqti in
- Caqti_type.custom
- ~encode:(fun
- DrainProfitsMessage.
- {
- wtid;
- debit_account_section;
- credit_payto_uri;
- date;
- amount;
- master_sig;
- }
- ->
- Ok
- (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig))
- ~decode:(fun
- (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig)
- ->
- Ok
- {
- wtid;
- debit_account_section;
- credit_payto_uri;
- date;
- amount;
- master_sig;
- })
- Caqti_type.(t6 b32 string string time amount master_sig)
-
-let aml_officer_setup =
- let master_sig = Signatures.MasterAmlOfficerStatus.caqti in
- Caqti_type.custom
- ~encode:(fun
- AmlOfficerSetup.
- {
- officer_pub;
- master_sig;
- officer_name;
- is_active;
- read_only;
- change_date;
- }
- ->
- Ok
- ( officer_pub,
- master_sig,
- officer_name,
- is_active,
- read_only,
- change_date ))
- ~decode:(fun
- ( officer_pub,
- master_sig,
- officer_name,
- is_active,
- read_only,
- change_date )
- ->
- Ok
- {
- officer_pub;
- master_sig;
- officer_name;
- is_active;
- read_only;
- change_date;
- })
- Caqti_type.(t6 eddsa_pub master_sig string bool bool time)
-
-let exchange_partner_setup =
- let master_sig = Signatures.PartnerConfiguration.caqti in
- Caqti_type.custom
- ~encode:(fun
- ExchangePartnerSetupRequest.
- {
- partner_pub;
- start_date;
- end_date;
- wad_frequency;
- wad_fee;
- master_sig;
- partner_base_url;
- }
- ->
- Ok
- ( partner_pub,
- start_date,
- end_date,
- wad_frequency,
- wad_fee,
- master_sig,
- partner_base_url ))
- ~decode:(fun
- ( partner_pub,
- start_date,
- end_date,
- wad_frequency,
- wad_fee,
- master_sig,
- partner_base_url )
- ->
- Ok
- {
- partner_base_url;
- partner_pub;
- wad_frequency;
- master_sig;
- start_date;
- end_date;
- wad_fee;
- })
- Caqti_type.(t7 eddsa_pub time time time_span amount master_sig string)
diff --git a/.jjconflict-side-1/src/respond.ml b/.jjconflict-side-1/src/respond.ml
deleted file mode 100644
index ea17f7f7..00000000
--- a/.jjconflict-side-1/src/respond.ml
+++ /dev/null
@@ -1,39 +0,0 @@
-(* TODO response
- use ErrorDetail *)
-
-let respond_json req content status =
- let open Vif.Response in
- let open Syntax in
- let* () = add ~field:"content-type" "application/json" in
- let* () = with_string req content in
- respond status
-
-let mk_error_content ?hint _status =
- let open Api in
- let code = -1 in
- let err = ErrorDetail.make ?hint code in
- encode_exn ErrorDetail.jsont err
-
-let error ~hint req =
- Logs.err (fun m -> m "internal server error: %s" hint);
- let body = mk_error_content ~hint `Internal_server_error in
- respond_json req body `Internal_server_error
-
-let bad_request ?hint req =
- Logs.err (fun m -> m "bad request");
- let body = mk_error_content ?hint `Bad_request in
- respond_json req body `Bad_request
-
-let ok content req =
- Logs.debug (fun m -> m "ok");
- respond_json req content `OK
-
-let not_modified () =
- Logs.debug (fun m -> m "not modified");
- let open Vif.Response in
- let open Syntax in
- let* () = empty in
- respond `Not_modified
-
-let result res req =
- match res with Error hint -> error ~hint req | Ok content -> ok content req
diff --git a/.jjconflict-side-1/src/signatures.ml b/.jjconflict-side-1/src/signatures.ml
deleted file mode 100644
index 1d57405e..00000000
--- a/.jjconflict-side-1/src/signatures.ml
+++ /dev/null
@@ -1,1310 +0,0 @@
-(* TODO signatures
- check with taler-wallet
- check signed/unsigned ints
- check endianness *)
-open Hash
-
-module Aliases = struct
- module Timestamp = struct
- type t = Time.Timestamp.t
-
- let bin = Time.Timestamp.bin
- end
-
- module TimestampNBO = struct
- type t = Time.Timestamp.t
-
- let bin = Time.Timestamp.bin_nbo
- end
-
- module TimeRelative = struct
- type t = Time.Relative.t
-
- let bin = Time.Relative.bin
- end
-
- module TimeRelativeNBO = struct
- type t = Time.Relative.t
-
- let bin = Time.Relative.bin_nbo
- end
-
- module AmountNBO = struct
- type t = Amount.t
-
- let bin = Amount.bin_nbo
- end
-
- (* - Keys - *)
-
- (* some of those are actuall ecdhe, or union of eddsa|ecdhe *)
- open Crypto
- module PursePublicKey = EddsaPublicKey
- module AuditorPublicKeyP = EddsaPublicKey
- module ReservePublicKeyP = EddsaPublicKey
- module MerchantPublicKeyP = EddsaPublicKey
- module TransferPublicKeyP = EddsaPublicKey
- module AmlOfficerPublicKeyP = EddsaPublicKey
- module ExchangePublicKeyP = EddsaPublicKey
- module MasterPublicKeyP = EddsaPublicKey
- module CoinSpendPublicKeyP = EddsaPublicKey
- module TokenPublicKeyP = EddsaPublicKey
- module ReservePrivateKeyP = EddsaPrivateKey
- module MerchantPrivateKeyP = EddsaPrivateKey
- module TransferPrivateKeyP = EddsaPrivateKey
- module AmlOfficerPrivateKeyP = EddsaPrivateKey
- module ExchangePrivateKeyP = EddsaPrivateKey
- module MasterPrivateKeyP = EddsaPrivateKey
- module CoinSpendPrivateKeyP = EddsaPrivateKey
- module MasterSignatureP = EddsaSignature
- module ReserveSignatureP = EddsaSignature
- module ExchangeSignatureP = EddsaSignature
- module CoinSpendSignatureP = EddsaSignature
-end
-
-open Aliases
-
-let int32_size = 4
-let int64_size = 8
-
-module Bytes32 = struct
- type t = string
-
- let bin = Bin.bytes 32
-end
-
-module Bytes64 = struct
- type t = string
-
- let bin = Bin.bytes 64
-end
-
-module TransferSecretP = Bytes64
-module LinkSecretP = Bytes64
-module EncryptedLinkSecretP = Bytes64
-module BlindingMasterSeed = Bytes32
-module BlindingMasterSecret = Bytes32
-module WireTransferIdentifierRawP = Bytes32
-module PublicRefreshCoinNonceP = Bytes64
-module DenominationBlindingKeyP = Bytes32
-module RefreshCommitmentP = Bytes64
-
-module UUID = struct
- type t = string
-
- let size = 4 * int32_size
- let bin = Bin.bytes size
-end
-
-module WadId = struct
- type t = string
-
- let size = 6 * int32_size
- let bin = Bin.bytes size
-end
-
-module AgeMask = struct
- type t = int32
-
- let bin = Bin.beint32
-end
-
-(* --- *)
-
-(* EccSignaturePurpose *)
-module Purpose = struct
- type t = {
- size: int32;
- purpose: int32;
- }
-
- let bin =
- let open Bin in
- record (fun size purpose -> { size; purpose })
- |+ field beint32 (fun t -> t.size)
- |+ field beint32 (fun t -> t.purpose)
- |> sealr
-
- let make ~size purpose = { size= Int32.of_int size; purpose }
- let dummy = make ~size:0 0_l
-
- (* helper function to make ['signature Bin.t]
- to compute [t.size], we first build a bin with a dummy purpose *)
- let make_bin =
- let get_size f =
- let open Bin in
- match Size.of_value (Size.size_of (f dummy)) with
- | Dynamic _ | Unknown ->
- Fmt.failwith "size_of failure: size is not Static"
- | Static n -> n
- in
- fun code f -> make ~size:(get_size f) code |> f
-
- let field purpose = Bin.field bin (fun _t -> purpose)
-end
-
-(* --- Packed Signatures --- *)
-
-module MK (R : sig
- type r
-
- val bin : r Bin.t
-end) : sig
- open Crypto
-
- type r = R.r
- type t
-
- val sign_f : f:(string -> eddsa_sig) -> r -> t
-
- val verify_f :
- f:(eddsa_sig -> msg:string -> (unit, string) result) ->
- t ->
- r ->
- (unit, string) result
-
- val jsont : t Jsont.t
- val caqti : t Caqti_type.t
-
- (* TODO rm *)
- (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *)
- val to_octets : t -> string
-end = struct
- open Crypto
-
- type r = R.r
- type t = EddsaSignature.t
-
- let to_string = Bin.to_string R.bin
- let sign_f ~f r = f (to_string r)
- let verify_f ~f t r = f t ~msg:(to_string r)
- let jsont = EddsaSignature.jsont
- let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti
- let to_octets t = EddsaSignature.to_octets t
-end
-
-module DenominationKeyAnnouncement = struct
- module R = struct
- (* CS: use purpose TALER_SIGNATURE_SM_CS_DENOMINATION_KEY *)
- (* purpose.purpose = TALER_SIGNATURE_SM_RSA_DENOMINATION_KEY *)
- type r = {
- h_denom_pub: DenominationHash.t;
- h_section_name: Hash.Cstring.H64.t;
- anchor_time: TimestampNBO.t;
- duration_withdraw: TimeRelativeNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.sm_rsa_denomination_key
- @@ fun purpose ->
- record
- (fun
- _purpose h_denom_pub h_section_name anchor_time duration_withdraw ->
- { h_denom_pub; h_section_name; anchor_time; duration_withdraw })
- |+ Purpose.field purpose
- |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_section_name)
- |+ field TimestampNBO.bin (fun t -> t.anchor_time)
- |+ field TimeRelativeNBO.bin (fun t -> t.duration_withdraw)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module SigningKeyAnnouncement = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_SM_SIGNING_KEY *)
- type r = {
- exchange_pub: ExchangePublicKeyP.t;
- anchor_time: TimestampNBO.t;
- duration: TimeRelativeNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.sm_signing_key @@ fun purpose ->
- record (fun _purpose exchange_pub anchor_time duration ->
- { exchange_pub; anchor_time; duration })
- |+ Purpose.field purpose
- |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
- |+ field TimestampNBO.bin (fun t -> t.anchor_time)
- |+ field TimeRelativeNBO.bin (fun t -> t.duration)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module DenominationKeyValidity = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_VALIDITY *)
- type r = {
- master: MasterPublicKeyP.t;
- start: TimestampNBO.t;
- expire_withdraw: TimestampNBO.t;
- expire_spend: TimestampNBO.t;
- expire_legal: TimestampNBO.t;
- value: AmountNBO.t;
- fee_withdraw: AmountNBO.t;
- fee_deposit: AmountNBO.t;
- fee_refresh: AmountNBO.t;
- (* TODO signatures taler doc *)
- fee_refund: AmountNBO.t;
- denom_hash: DenominationHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_denomination_key_validity
- @@ fun purpose ->
- record
- (fun
- _purpose
- master
- start
- expire_withdraw
- expire_spend
- expire_legal
- value
- fee_withdraw
- fee_deposit
- fee_refresh
- fee_refund
- denom_hash
- ->
- {
- master;
- start;
- expire_withdraw;
- expire_spend;
- expire_legal;
- value;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- denom_hash;
- })
- |+ Purpose.field purpose
- |+ field MasterPublicKeyP.bin (fun t -> t.master)
- |+ field TimestampNBO.bin (fun t -> t.start)
- |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
- |+ field TimestampNBO.bin (fun t -> t.expire_spend)
- |+ field TimestampNBO.bin (fun t -> t.expire_legal)
- |+ field AmountNBO.bin (fun t -> t.value)
- |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
- |+ field AmountNBO.bin (fun t -> t.fee_deposit)
- |+ field AmountNBO.bin (fun t -> t.fee_refresh)
- |+ field AmountNBO.bin (fun t -> t.fee_refund)
- |+ field DenominationHash.bin (fun t -> t.denom_hash)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module ExchangeSigningKeyValidity = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_VALIDITY *)
- type r = {
- start: TimestampNBO.t;
- expire: TimestampNBO.t;
- end_: TimestampNBO.t;
- signkey_pub: ExchangePublicKeyP.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_signing_key_validity
- @@ fun purpose ->
- record (fun _purpose start expire end_ signkey_pub ->
- { start; expire; end_; signkey_pub })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.start)
- |+ field TimestampNBO.bin (fun t -> t.expire)
- |+ field TimestampNBO.bin (fun t -> t.end_)
- |+ field ExchangePublicKeyP.bin (fun t -> t.signkey_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDenominationKeyRevocation = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_REVOKED. *)
- type r = { h_denom_pub: DenominationHash.t }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_denomination_key_revoked
- @@ fun purpose ->
- record (fun _purpose h_denom_pub -> { h_denom_pub })
- |+ Purpose.field purpose
- |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterSigningKeyRevocation = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_REVOKED *)
- type r = { exchange_pub: ExchangePublicKeyP.t }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_signing_key_revoked
- @@ fun purpose ->
- record (fun _purpose exchange_pub -> { exchange_pub })
- |+ Purpose.field purpose
- |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterAddAuditor = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_AUDITOR *)
- type r = {
- start_date: TimestampNBO.t;
- auditor_pub: AuditorPublicKeyP.t;
- h_auditor_url: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_add_auditor @@ fun purpose ->
- record (fun _purpose start_date auditor_pub h_auditor_url ->
- { start_date; auditor_pub; h_auditor_url })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_auditor_url)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDelAuditor = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_AUDITOR *)
- type r = {
- end_date: TimestampNBO.t;
- auditor_pub: AuditorPublicKeyP.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_del_auditor @@ fun purpose ->
- record (fun _purpose end_date auditor_pub -> { end_date; auditor_pub })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module GlobalFees = struct
- module R = struct
- (* TODO signatures taler doc *)
- (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *)
- type r = {
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- purse_timeout: TimeRelativeNBO.t;
- history_expiration: TimeRelativeNBO.t;
- history_fee: AmountNBO.t;
- account_fee: AmountNBO.t;
- purse_fee: AmountNBO.t;
- purse_account_limit: int32;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_global_fees @@ fun purpose ->
- record
- (fun
- _purpose
- start_date
- end_date
- purse_timeout
- history_expiration
- history_fee
- account_fee
- purse_fee
- purse_account_limit
- ->
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- })
- |+ Purpose.field purpose
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field TimeRelativeNBO.bin (fun t -> t.purse_timeout)
- |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration)
- |+ field AmountNBO.bin (fun t -> t.history_fee)
- |+ field AmountNBO.bin (fun t -> t.account_fee)
- |+ field AmountNBO.bin (fun t -> t.purse_fee)
- |+ field beint32 (fun t -> t.purse_account_limit)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterWireDetails = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_DETAILS *)
- type r = {
- h_wire_details: FullPaytoHash.t;
- h_conversion_url: Hash.Cstring.H64.t;
- h_credit_restrictions: Hash.Cstring.H64.t;
- h_debit_restrictions: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_wire_details @@ fun purpose ->
- record
- (fun
- _purpose
- h_wire_details
- h_conversion_url
- h_credit_restrictions
- h_debit_restrictions
- ->
- {
- h_wire_details;
- h_conversion_url;
- h_credit_restrictions;
- h_debit_restrictions;
- })
- |+ Purpose.field purpose
- |+ field FullPaytoHash.bin (fun t -> t.h_wire_details)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterAddWire = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_WIRE *)
- type r = {
- start_date: TimestampNBO.t;
- h_wire: FullPaytoHash.t;
- h_conversion_url: Hash.Cstring.H64.t;
- h_credit_restrictions: Hash.Cstring.H64.t;
- h_debit_restrictions: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_add_wire @@ fun _purpose ->
- record
- (fun
- _purpose
- start_date
- h_wire
- h_conversion_url
- h_credit_restrictions
- h_debit_restrictions
- ->
- {
- start_date;
- h_wire;
- h_conversion_url;
- h_credit_restrictions;
- h_debit_restrictions;
- })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field FullPaytoHash.bin (fun t -> t.h_wire)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDelWire = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_WIRE *)
- type r = {
- end_date: TimestampNBO.t;
- h_wire: FullPaytoHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_del_wire @@ fun _purpose ->
- record (fun _purpose end_date h_wire -> { end_date; h_wire })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field FullPaytoHash.bin (fun t -> t.h_wire)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterDrainProfit = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_DRAIN_PROFITS *)
- type r = {
- wtid: WireTransferIdentifierRawP.t;
- date: TimestampNBO.t;
- amount: AmountNBO.t;
- h_section: Hash.Cstring.H64.t;
- h_payto: FullPaytoHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_drain_profit @@ fun _purpose ->
- record (fun _purpose wtid date amount h_section h_payto ->
- { wtid; date; amount; h_section; h_payto })
- |+ Purpose.field _purpose
- |+ field WireTransferIdentifierRawP.bin (fun t -> t.wtid)
- |+ field TimestampNBO.bin (fun t -> t.date)
- |+ field AmountNBO.bin (fun t -> t.amount)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_section)
- |+ field FullPaytoHash.bin (fun t -> t.h_payto)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterAmlOfficerStatus = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_AML_KEY *)
- type r = {
- change_date: TimestampNBO.t;
- officer_pub: AmlOfficerPublicKeyP.t;
- h_officer_name: Hash.Cstring.H64.t;
- is_active: int32;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_aml_key @@ fun _purpose ->
- record (fun _purpose change_date officer_pub h_officer_name is_active ->
- { change_date; officer_pub; h_officer_name; is_active })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.change_date)
- |+ field AmlOfficerPublicKeyP.bin (fun t -> t.officer_pub)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_officer_name)
- |+ field beint32 (fun t -> t.is_active)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module PartnerConfiguration = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_PARNTER_DETAILS *)
- type r = {
- partner_pub: MasterPublicKeyP.t;
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- wad_frequency: TimeRelativeNBO.t;
- wad_fee: AmountNBO.t;
- h_url: Hash.Cstring.H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_partner_details
- @@ fun _purpose ->
- record
- (fun
- _purpose
- partner_pub
- start_date
- end_date
- wad_frequency
- wad_fee
- h_url
- -> { partner_pub; start_date; end_date; wad_frequency; wad_fee; h_url })
- |+ Purpose.field _purpose
- |+ field MasterPublicKeyP.bin (fun t -> t.partner_pub)
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
- |+ field AmountNBO.bin (fun t -> t.wad_fee)
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_url)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module WadPartnerSignature = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_PARTNER_DETAILS *)
- type r = {
- h_partner_base_url: Hash.Cstring.H64.t;
- master_public_key: MasterPublicKeyP.t;
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- wad_fee: AmountNBO.t;
- wad_frequency: TimeRelativeNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_partner_details
- @@ fun _purpose ->
- record
- (fun
- _purpose
- h_partner_base_url
- master_public_key
- start_date
- end_date
- wad_fee
- wad_frequency
- ->
- {
- h_partner_base_url;
- master_public_key;
- start_date;
- end_date;
- wad_fee;
- wad_frequency;
- })
- |+ Purpose.field _purpose
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_partner_base_url)
- |+ field MasterPublicKeyP.bin (fun t -> t.master_public_key)
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field AmountNBO.bin (fun t -> t.wad_fee)
- |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module MasterWireFee = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_FEES *)
- type r = {
- h_wire_method: Hash.Cstring.H64.t;
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- wire_fee: AmountNBO.t;
- closing_fee: AmountNBO.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.master_wire_fees @@ fun _purpose ->
- record
- (fun _purpose h_wire_method start_date end_date wire_fee closing_fee ->
- { h_wire_method; start_date; end_date; wire_fee; closing_fee })
- |+ Purpose.field _purpose
- |+ field Hash.Cstring.H64.bin (fun t -> t.h_wire_method)
- |+ field TimestampNBO.bin (fun t -> t.start_date)
- |+ field TimestampNBO.bin (fun t -> t.end_date)
- |+ field AmountNBO.bin (fun t -> t.wire_fee)
- |+ field AmountNBO.bin (fun t -> t.closing_fee)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module ExchangeKeyValidity = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_AUDITOR_EXCHANGE_KEYS *)
- type r = {
- auditor_url_hash: Hash.Cstring.H64.t;
- master: MasterPublicKeyP.t;
- start: TimestampNBO.t;
- expire_withdraw: TimestampNBO.t;
- expire_spend: TimestampNBO.t;
- expire_legal: TimestampNBO.t;
- value: AmountNBO.t;
- fee_withdraw: AmountNBO.t;
- fee_deposit: AmountNBO.t;
- fee_refresh: AmountNBO.t;
- denom_hash: DenominationHash.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.auditor_exchange_keys @@ fun _purpose ->
- record
- (fun
- _purpose
- auditor_url_hash
- master
- start
- expire_withdraw
- expire_spend
- expire_legal
- value
- fee_withdraw
- fee_deposit
- fee_refresh
- denom_hash
- ->
- {
- auditor_url_hash;
- master;
- start;
- expire_withdraw;
- expire_spend;
- expire_legal;
- value;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- denom_hash;
- })
- |+ Purpose.field _purpose
- |+ field Hash.Cstring.H64.bin (fun t -> t.auditor_url_hash)
- |+ field MasterPublicKeyP.bin (fun t -> t.master)
- |+ field TimestampNBO.bin (fun t -> t.start)
- |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
- |+ field TimestampNBO.bin (fun t -> t.expire_spend)
- |+ field TimestampNBO.bin (fun t -> t.expire_legal)
- |+ field AmountNBO.bin (fun t -> t.value)
- |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
- |+ field AmountNBO.bin (fun t -> t.fee_deposit)
- |+ field AmountNBO.bin (fun t -> t.fee_refresh)
- |+ field DenominationHash.bin (fun t -> t.denom_hash)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-module ExchangeKeySet = struct
- module R = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_KEY_SET *)
- type r = {
- list_issue_date: TimestampNBO.t;
- (* hash over a concatenation of master_sigs *)
- hc: H64.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.exchange_key_set @@ fun _purpose ->
- record (fun _purpose list_issue_date hc -> { list_issue_date; hc })
- |+ Purpose.field _purpose
- |+ field TimestampNBO.bin (fun t -> t.list_issue_date)
- |+ field H64.bin (fun t -> t.hc)
- |> sealr
- end
-
- include R
- include MK (R)
-end
-
-(* ### BIN IMPL END ### *)
-
-module WithdrawRequest = struct
- (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
- type t = {
- amount: Amount.t;
- fee: Amount.t;
- h_planchets: HashPlanchetsP.t;
- blinding_seed: BlindingMasterSecret.t;
- max_age_group: int32;
- mask: AgeMask.t;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.wallet_reserve_withdraw @@ fun purpose ->
- record
- (fun _purpose amount fee h_planchets blinding_seed max_age_group mask ->
- { amount; fee; h_planchets; blinding_seed; max_age_group; mask })
- |+ Purpose.field purpose
- |+ field Amount.bin (fun t -> t.amount)
- |+ field Amount.bin (fun t -> t.fee)
- |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
- |+ field BlindingMasterSecret.bin (fun t -> t.blinding_seed)
- |+ field beint32 (fun t -> t.max_age_group)
- |+ field AgeMask.bin (fun t -> t.mask)
- |> sealr
-end
-
-module WithdrawConfirmation = struct
- (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW *)
- type t = {
- h_planchets: HashPlanchetsP.t;
- noreveal_index: int32;
- }
-
- let bin =
- let open Bin in
- Purpose.make_bin Taler_signatures.exchange_confirm_withdraw
- @@ fun purpose ->
- record (fun _purpose h_planchets noreveal_index ->
- { h_planchets; noreveal_index })
- |+ Purpose.field purpose
- |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
- |+ field beint32 (fun t -> t.noreveal_index)
- |> sealr
-end
-
-module SingleWithdrawRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
- type t = {
- amount_with_fee: AmountNBO.t;
- h_denomination_pub: DenominationHash.t;
- h_coin_envelope: BlindedCoinHash.t;
- }
-end
-
-module DepositRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_DEPOSIT *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_age_commitment: AgeCommitmentHash.t;
- h_policy: ExtensionsPolicyHash.t;
- h_wire: MerchantWireHash.t;
- h_denom_pub: DenominationHash.t;
- timestamp: TimestampNBO.t;
- refund_deadline: TimestampNBO.t;
- amount_with_fee: AmountNBO.t;
- deposit_fee: AmountNBO.t;
- merchant: MerchantPublicKeyP.t;
- wallet_data_hash: Hash.Cstring.H64.t;
- }
-end
-
-module DepositConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_DEPOSIT *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_wire: MerchantWireHash.t;
- h_policy: ExtensionsPolicyHash.t;
- timestamp: TimestampNBO.t;
- refund_deadline: TimestampNBO.t;
- amount_without_fee: AmountNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- merchant: MerchantPublicKeyP.t;
- }
-end
-
-module RefreshMeltCoinAffirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_MELT *)
- type t = {
- session_hash: RefreshCommitmentP.t;
- h_denom_pub: DenominationHash.t;
- h_age_commitment: AgeCommitmentHash.t;
- amount_with_fee: AmountNBO.t;
- melt_fee: AmountNBO.t;
- }
-end
-
-module RefreshMeltConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_MELT *)
- type t = {
- session_hash: RefreshCommitmentP.t;
- noreveal_index: int; (* uint16_t mapped to OCaml int *)
- }
-end
-
-module DepositTrack = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_wire: MerchantWireHash.t;
- coin_pub: CoinSpendPublicKeyP.t;
- }
-end
-
-module WireDepositDetailP = struct
- type t = {
- h_contract_terms: PrivateContractHash.t;
- execution_time: TimestampNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- deposit_value: AmountNBO.t;
- deposit_fee: AmountNBO.t;
- }
-end
-
-module WireDepositData = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE_DEPOSIT *)
- type t = {
- total: AmountNBO.t;
- wire_fee: AmountNBO.t;
- merchant_pub: MerchantPublicKeyP.t;
- h_wire: MerchantWireHash.t;
- h_details: Hash.Cstring.H64.t;
- }
-end
-
-module PaymentResponse = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_PAYMENT_OK *)
- type t = { h_contract_terms: PrivateContractHash.t }
-end
-
-module Contract = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_CONTRACT *)
- type t = { h_contract_terms: PrivateContractHash.t }
-end
-
-module ConfirmWire = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE *)
- type t = {
- h_wire: MerchantWireHash.t;
- h_contract_terms: PrivateContractHash.t;
- wtid: WireTransferIdentifierRawP.t;
- coin_pub: CoinSpendPublicKeyP.t;
- execution_time: TimestampNBO.t;
- coin_contribution: AmountNBO.t;
- }
-end
-
-module RefundConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_REFUND *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- coin_pub: CoinSpendPublicKeyP.t;
- merchant: MerchantPublicKeyP.t;
- rtransaction_id: int64;
- refund_amount: AmountNBO.t;
- }
-end
-
-module DepositTrackPS2 = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- h_wire: MerchantWireHash.t;
- merchant: MerchantPublicKeyP.t;
- coin_pub: CoinSpendPublicKeyP.t;
- }
-end
-
-module RefundRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND *)
- type t = {
- h_contract_terms: PrivateContractHash.t;
- coin_pub: CoinSpendPublicKeyP.t;
- rtransaction_id: int64;
- refund_amount: AmountNBO.t;
- refund_fee: AmountNBO.t;
- }
-end
-
-module MerchantRefundConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND_OK *)
- (* Hash of the order ID (a string), hashed without the 0-termination. *)
- type t = { h_order_id: Hash.Cstring.H64.t }
-end
-
-module RecoupRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_RECOUP or TALER_SIGNATURE_WALLET_COIN_RECOUP_REFRESH *)
- type t = {
- h_denom_pub: DenominationHash.t;
- coin_blind: DenominationBlindingKeyP.t;
- }
-end
-
-module RecoupRefreshConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP_REFRESH *)
- type t = {
- timestamp: TimestampNBO.t;
- recoup_amount: AmountNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- old_coin_pub: CoinSpendPublicKeyP.t;
- }
-end
-
-module RecoupConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP *)
- type t = {
- timestamp: TimestampNBO.t;
- recoup_amount: AmountNBO.t;
- coin_pub: CoinSpendPublicKeyP.t;
- reserve_pub: ReservePublicKeyP.t;
- }
-end
-
-module DenominationUnknownAffirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_AFFIRM_DENOM_UNKNOWN *)
- type t = {
- timestamp: TimestampNBO.t;
- h_denom_pub: DenominationHash.t;
- }
-end
-
-module DenominationExpiredAffirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_GENERIC_DENOMINATIN_EXPIRED *)
- type t = {
- timestamp: TimestampNBO.t;
- operation: string; (* char[8] → string *)
- h_denom_pub: DenominationHash.t;
- }
-end
-
-module ReserveCloseConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_CLOSED *)
- type t = {
- timestamp: TimestampNBO.t;
- closing_amount: AmountNBO.t;
- reserve_pub: ReservePublicKeyP.t;
- h_wire: FullPaytoHash.t;
- }
-end
-
-module CoinLinkSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
- type t = {
- h_denom_pub: DenominationHash.t;
- old_coin_pub: CoinSpendPublicKeyP.t;
- transfer_pub: TransferPublicKeyP.t;
- coin_envelope_hash: BlindedCoinHash.t;
- }
-end
-
-module RefreshNonceSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
- type t = { nonce: PublicRefreshCoinNonceP.t }
-end
-
-module ReserveStatusRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_RESERVE_STATUS_REQUEST *)
- type t = { request_timestamp: TimestampNBO.t }
-end
-
-module ReserveHistoryRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_RESERVE_HISTORY_REQUEST *)
- type t = {
- history_fee: AmountNBO.t;
- request_timestamp: TimestampNBO.t;
- }
-end
-
-module PurseStatusRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_REQUEST *)
- type t = unit
-end
-
-module PurseStatusResponseSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_RESPONSE *)
- type t = {
- total_purse_amount: AmountNBO.t;
- total_deposit_amount: AmountNBO.t;
- max_deposit_fees: AmountNBO.t;
- purse_expiration: TimestampNBO.t;
- status_timestamp: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- }
-end
-
-module ReserveCloseRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
- type t = unit
-end
-
-module PurseRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_CREATE *)
- type t = {
- purse_expiration: TimestampNBO.t;
- merge_value_after_fees: AmountNBO.t;
- h_contract_terms: PrivateContractHash.t;
- min_age: int;
- }
-end
-
-module PurseDepositSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT *)
- type t = {
- coin_contribution: AmountNBO.t;
- h_denom_pub: DenominationHash.t;
- h_age_commitment: AgeCommitmentHash.t;
- purse_pub: PursePublicKey.t;
- h_exchange_base_url: Hash.Cstring.H64.t;
- }
-end
-
-module PurseDepositSignaturePS2 = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN_DEPOSIT *)
- type t = {
- reserve_sig: ReserveSignatureP.t;
- coin_contribution: AmountNBO.t;
- }
-end
-
-module PurseDepositConfirmedSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT_CONFIRMED *)
- type t = {
- total_purse_amount: AmountNBO.t;
- total_deposit_fees: AmountNBO.t;
- purse_pub: PursePublicKey.t;
- purse_expiration: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- }
-end
-
-module PurseMergeSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_MERGE *)
- type t = {
- merge_timestamp: TimestampNBO.t;
- h_wire: NormalizedPaytoHash.t;
- }
-end
-
-module AccountMergeSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_MERGE *)
- type t = {
- reserve_pub: ReservePublicKeyP.t;
- purse_pub: PursePublicKey.t;
- merge_amount_after_fees: AmountNBO.t;
- merge_timestamp: TimestampNBO.t;
- purse_expiration: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- min_age: int;
- }
-end
-
-module AccountSetupRequestSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_SETUP *)
- type t = { threshold: AmountNBO.t }
-end
-
-module PurseMergeSuccessSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_PURSE_MERGE_SUCCESS *)
- type t = {
- reserve_pub: ReservePublicKeyP.t;
- purse_pub: PursePublicKey.t;
- merge_amount_after_fees: AmountNBO.t;
- contract_time: TimestampNBO.t;
- h_contract_terms: PrivateContractHash.t;
- h_wire: NormalizedPaytoHash.t;
- min_age: int;
- }
-end
-
-module WadDataSignature = struct
- (* purpose.purpose = TALER_SIGNATURE_WAD_DATA *)
- type t = {
- wad_execution_time: TimestampNBO.t;
- total_amount: AmountNBO.t;
- h_items: Hash.Cstring.H64.t;
- wad_id: WadId.t;
- }
-end
-
-module P2PFees = struct
- (* purpose.purpose = TALER_SIGNATURE_P2P_FEES *)
- type t = {
- start_date: TimestampNBO.t;
- end_date: TimestampNBO.t;
- kyc_fee: AmountNBO.t;
- purse_fee: AmountNBO.t;
- account_history_fee: AmountNBO.t;
- account_annual_fee: AmountNBO.t;
- account_kyc_timeout: TimeRelativeNBO.t;
- purse_timeout: TimeRelativeNBO.t;
- purse_account_limit: int;
- }
-end
-
-module CoinPurseRefundConfirmation = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_PURSE_REFUND *)
- type t = {
- purse_pub: PursePublicKey.t;
- coin_pub: CoinSpendPublicKeyP.t;
- refunded_amount: AmountNBO.t;
- refund_fee: AmountNBO.t;
- }
-end
-
-module AmlDecision = struct
- (* purpose.purpose = TALER_SIGNATURE_AML_DECISION *)
- type t = {
- h_justification: Hash.Cstring.H64.t;
- decision_time: TimestampNBO.t;
- new_threshold: AmountNBO.t;
- h_payto: NormalizedPaytoHash.t;
- h_kyc_requirements: Hash.Cstring.H64.t;
- new_state: int;
- }
-end
-
-module ReserveOpen = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN *)
- type t = {
- reserve_payment: AmountNBO.t;
- request_timestamp: TimestampNBO.t;
- reserve_expiration: TimestampNBO.t;
- purse_limit: int;
- }
-end
-
-module ReserveClose = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
- type t = {
- request_timestamp: TimestampNBO.t;
- target_account_h_payto: FullPaytoHash.t;
- }
-end
-
-module ReserveAttestRequest = struct
- (* purpose.purpose = TALER_SIGNATURE_WALLET_ATTEST_REQUEST *)
- type t = {
- request_timestamp: TimestampNBO.t;
- h_details: Hash.Cstring.H64.t;
- }
-end
-
-module ExchangeAttest = struct
- (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_ATTEST_DETAILS *)
- type t = {
- attest_timestamp: TimestampNBO.t;
- expiration_time: TimestampNBO.t;
- reserve_pub: ReservePublicKeyP.t;
- h_attributes: Hash.Cstring.H64.t;
- }
-end
diff --git a/.jjconflict-side-1/src/signkey.ml b/.jjconflict-side-1/src/signkey.ml
deleted file mode 100644
index a710aee6..00000000
--- a/.jjconflict-side-1/src/signkey.ml
+++ /dev/null
@@ -1,11 +0,0 @@
-open Crypto
-
-(* TODO replace by Api.SignKey.t instead? (no revoked_sig) *)
-type t = {
- pub: eddsa_pub;
- stamp_start: Timestamp.t;
- stamp_expire: Timestamp.t;
- stamp_end: Timestamp.t;
- master_sig: Signatures.ExchangeSigningKeyValidity.t;
- revoked_sig: Signatures.MasterSigningKeyRevocation.t option;
-}
diff --git a/.jjconflict-side-1/src/syntax.ml b/.jjconflict-side-1/src/syntax.ml
deleted file mode 100644
index c61aba15..00000000
--- a/.jjconflict-side-1/src/syntax.ml
+++ /dev/null
@@ -1,51 +0,0 @@
-let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
-let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e
-
-(* TODO use polymorphic variant for errors *)
-let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
-
-let unwrap_err_caqti o =
- match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
-
-let list_iter f l =
- let err = ref None in
- try
- List.iter
- (fun v ->
- match f v with
- | Error _e as e ->
- err := Some e;
- raise Exit
- | Ok () -> ())
- l;
- Ok ()
- with Exit -> ( match !err with None -> assert false | Some v -> v)
-
-let list_map f l =
- let err = ref None in
- try
- Ok
- (List.map
- (fun v ->
- match f v with
- | Error _e as e ->
- err := Some e;
- raise Exit
- | Ok v -> v)
- l)
- with Exit -> ( match !err with None -> assert false | Some v -> v)
-
-let list_fold_left f acc l =
- List.fold_left
- (fun acc v ->
- let* acc = acc in
- f acc v)
- (Ok acc) l
-
-let opt_list l =
- match (List.for_all Option.is_none l, List.for_all Option.is_some l) with
- | _, true ->
- let l = List.map Option.get l in
- Ok (Some l)
- | true, _ -> Ok None
- | _, _ -> Error ()
diff --git a/.jjconflict-side-1/src/taler_signatures.ml b/.jjconflict-side-1/src/taler_signatures.ml
deleted file mode 100644
index 8715b472..00000000
--- a/.jjconflict-side-1/src/taler_signatures.ml
+++ /dev/null
@@ -1,280 +0,0 @@
-(* This file was generated from the GANA database:
- https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)
-
-(** Initialize or update the status of an AML key for an AML officer *)
-let master_aml_key : int32 = 1017_l
-
-(** Affirm wiring of exchange profits to operator account. *)
-let master_drain_profit : int32 = 1018_l
-
-(** Signature affirming a partner configuration for wads. *)
-let master_partner_details : int32 = 1019_l
-
-(** The given revocation key was revoked and must no longer be used. *)
-let master_signing_key_revoked : int32 = 1020_l
-
-(** Add payto URI to the list of our wire methods. *)
-let master_add_wire : int32 = 1021_l
-
-(** Signature over global set of fees charged by the exchange. *)
-let master_global_fees : int32 = 1022_l
-
-(** Remove payto URI from the list of our wire methods. *)
-let master_del_wire : int32 = 1023_l
-
-(** Purpose for signing public keys signed by the exchange master key. *)
-let master_signing_key_validity : int32 = 1024_l
-
-(** Purpose for denomination keys signed by the exchange master key. *)
-let master_denomination_key_validity : int32 = 1025_l
-
-(** Add an auditor to the list of our auditors. *)
-let master_add_auditor : int32 = 1026_l
-
-(** Remove an auditor from the list of our auditors. *)
-let master_del_auditor : int32 = 1027_l
-
-(** Fees charged per (aggregate) wire transfer to the merchant. *)
-let master_wire_fees : int32 = 1028_l
-
-(** The given revocation key was revoked and must no longer be used. *)
-let master_denomination_key_revoked : int32 = 1029_l
-
-(** Signature where the Exchange confirms its IBAN details in the /wire
- response. *)
-let master_wire_details : int32 = 1030_l
-
-(** Set the configuration of an extension (age-restriction or peer2peer) *)
-let master_extension : int32 = 1031_l
-
-(** Purpose for the state of a reserve, signed by the exchange's signing key. *)
-let exchange_reserve_status : int32 = 1032_l
-
-(** Signature where the Exchange confirms a deposit request. *)
-let exchange_confirm_deposit : int32 = 1033_l
-
-(** Signature where the exchange (current signing key) confirms the no-reveal
- index for cut-and-choose and the validity of the melted coins. *)
-let exchange_confirm_melt : int32 = 1034_l
-
-(** Signature where the Exchange confirms the full /keys response set. *)
-let exchange_key_set : int32 = 1035_l
-
-(** Signature where the Exchange confirms the /track/transaction response. *)
-let exchange_confirm_wire : int32 = 1036_l
-
-(** Signature where the Exchange confirms the /wire/deposit response. *)
-let exchange_confirm_wire_deposit : int32 = 1037_l
-
-(** Signature where the Exchange confirms a refund request. *)
-let exchange_confirm_refund : int32 = 1038_l
-
-(** Signature where the Exchange confirms a recoup. *)
-let exchange_confirm_recoup : int32 = 1039_l
-
-(** Signature where the Exchange confirms it closed a reserve. *)
-let exchange_reserve_closed : int32 = 1040_l
-
-(** Signature where the Exchange confirms a recoup-refresh operation. *)
-let exchange_confirm_recoup_refresh : int32 = 1041_l
-
-(** Signature where the Exchange confirms that it does not know a denomination
- (hash). *)
-let exchange_affirm_denom_unknown : int32 = 1042_l
-
-(** Signature where the Exchange confirms that it does not consider a
- denomination valid for the given operation at this time. *)
-let exchange_affirm_denom_expired : int32 = 1043_l
-
-(** Signature by which the exchange affirms that a purse was created with a
- certain amount deposited into it. *)
-let exchange_confirm_purse_creation : int32 = 1045_l
-
-(** Signature by which the exchange affirms that a purse was merged into a
- reserve with a certain amount in it. *)
-let exchange_confirm_purse_merged : int32 = 1046_l
-
-(** Purpose for the state of a purse, signed by the exchange's signing key. *)
-let exchange_purse_status : int32 = 1047_l
-
-(** Signature by which the exchange attests identity attributes of a particular
- reserve owner. *)
-let exchange_reserve_attest_details : int32 = 1048_l
-
-(** Signature by which the exchange confirms that a purse expired and a coin was
- refunded. *)
-let exchange_confirm_purse_refund : int32 = 1049_l
-
-(** Signature where the Exchange confirms an (age-)withdraw. *)
-let exchange_confirm_withdraw : int32 = 1050_l
-
-(** Signature where the auditor confirms that he is aware of certain
- denomination keys from the exchange. *)
-let auditor_exchange_keys : int32 = 1064_l
-
-(** Signature where the merchant confirms a contract (to the customer). *)
-let merchant_contract : int32 = 1101_l
-
-(** Signature where the merchant confirms a refund (of a coin). *)
-let merchant_refund : int32 = 1102_l
-
-(** Signature where the merchant confirms that he needs the wire transfer
- identifier for a deposit operation. *)
-let merchant_track_transaction : int32 = 1103_l
-
-(** Signature where the merchant confirms that the payment was successful *)
-let merchant_payment_ok : int32 = 1104_l
-
-(** Signature where the merchant confirms its own (salted) wire details (not yet
- really used). *)
-let merchant_wire_details : int32 = 1107_l
-
-(** Signature where the merchant issues a token by blindly signing it. Signed
- with the token issue private key. *)
-let merchant_token_issue : int32 = 1108_l
-
-(** Signature where the reserve key confirms a withdraw request. Signed with the
- reserve private key. *)
-let wallet_reserve_withdraw : int32 = 1200_l
-
-(** Signature made by the wallet of a user to confirm a deposit of a coin. *)
-let wallet_coin_deposit : int32 = 1201_l
-
-(** Signature using a coin key confirming the melting of a coin. Signed with the
- coin's private key. *)
-let wallet_coin_melt : int32 = 1202_l
-
-(** Signature using a coin key requesting recoup. Signed with the coin's private
- key. *)
-let wallet_coin_recoup : int32 = 1203_l
-
-(** Signature using a coin key authenticating link data. Signed with the old
- coin's private key. *)
-let wallet_coin_link : int32 = 1204_l
-
-(** Signature using a reserve key by which a wallet requests a payment target
- UUID for itself. Signs over just a purpose (no body), as the signature only
- serves to demonstrate that the request comes from the wallet controlling the
- private key, and not some third party. *)
-let wallet_account_setup : int32 = 1205_l
-
-(** Signature using a coin key requesting recoup-refresh. Signed with the coin
- private key. *)
-let wallet_coin_recoup_refresh : int32 = 1206_l
-
-(** Signature using a age restriction key for attestation of a particular
- age/age-group. *)
-let wallet_age_attestation : int32 = 1207_l
-
-(** Request full or partial reserve history. Signed with the reserve private
- key. *)
-let wallet_reserve_history : int32 = 1208_l
-
-(** Request full or partial coin history. Signed with the coin private key. *)
-let wallet_coin_history : int32 = 1209_l
-
-(** Request purse creation (without reserve). Signed by the purse private key.
-*)
-let wallet_purse_create : int32 = 1210_l
-
-(** Request coin to be deposited into a purse. Signed with the coin private key.
-*)
-let wallet_purse_deposit : int32 = 1211_l
-
-(** Request purse status. Signed with the purse private key. *)
-let wallet_purse_status : int32 = 1212_l
-
-(** Request purse to be merged with a reserve. Signed with the purse private
- key. *)
-let wallet_purse_merge : int32 = 1213_l
-
-(** Request purse to be merged with a reserve. Signed by the reserve private
- key. *)
-let wallet_account_merge : int32 = 1214_l
-
-(** Request account to be closed. Signed with the reserve private key. *)
-let wallet_reserve_close : int32 = 1215_l
-
-(** Associates encrypted contract with a purse. Signed with the purse private
- key. *)
-let wallet_purse_econtract : int32 = 1216_l
-
-(** Request reserve to be kept open. Signed with the reserve private key. *)
-let wallet_reserve_open : int32 = 1217_l
-
-(** Request coin to be used to pay for reserve to be kept open. Signed with the
- coin private key. *)
-let wallet_reserve_open_deposit : int32 = 1218_l
-
-(** Request attestation about reserve owner. Signed by the reserve private key.
-*)
-let wallet_reserve_attest_details : int32 = 1219_l
-
-(** Signature by which a wallet requests a purse to be deleted. *)
-let wallet_purse_delete : int32 = 1220_l
-
-(** Signature where the reserve key confirms an age-withdraw request. Signed
- with the reserve private key. *)
-let wallet_reserve_age_withdraw : int32 = 1221_l
-
-(** Signature where the token use key confirms the usage of a token on a pay
- request. Signed with the token use private key. *)
-let wallet_token_use : int32 = 1222_l
-
-(** Signature used to unclaim an order, allowing other wallets to claim it.
- Signed with the private key of the claim nonce. *)
-let wallet_order_unclaim : int32 = 1223_l
-
-(** Signature on a denomination key announcement. *)
-let sm_rsa_denomination_key : int32 = 1250_l
-
-(** Signature on an exchange message signing key announcement. *)
-let sm_signing_key : int32 = 1251_l
-
-(** Signature on a denomination key announcement. *)
-let sm_cs_denomination_key : int32 = 1252_l
-
-(** EdDSA test signature. *)
-let client_test_eddsa : int32 = 1302_l
-
-(** EdDSA test signature. *)
-let exchange_test_eddsa : int32 = 1303_l
-
-(** Signature by which an AML officer signs an AML decision. *)
-let aml_decision : int32 = 1350_l
-
-(** Signature by which an AML officer requests AML data. *)
-let aml_query : int32 = 1351_l
-
-(** Signature by which an account owner authorizes access to a KYC operation. *)
-let kyc_auth : int32 = 1360_l
-
-(** EdDSA signature for a policy upload. *)
-let anastasis_policy_upload : int32 = 1400_l
-
-(** EdDSA signature for a backup upload. *)
-let sync_backup_upload : int32 = 1450_l
-
-(** The signature is done by the Donau. The Donau signes over the total amount
- of the corresponding year, the corresponding year and the donation
- identifier of a specific donor. The statement confirms that the donor made
- this total in donations for the given year. *)
-let donau_donation_statement : int32 = 1500_l
-
-(** The signature is made by a charity and shows that the charity is in
- agreement with the donation request which it sends to the Donau. The charity
- signs over all blinded identifiers and key pairs which it has received from
- the donor. The signature affirms that the charity wants the donation
- receipts to be issued on its behalf. *)
-let charity_donation_confirmation : int32 = 1501_l
-
-(** The signature is made by a charity to request information about its status
- from a Donau. It is not over anything in particular and is just there for
- access control. *)
-let charity_get_info : int32 = 1502_l
-
-(** Signature over messages to delete in the mailbox service *)
-let mailbox_messages_delete : int32 = 1551_l
-
-(** Signature for mailbox registration request *)
-let mailbox_register : int32 = 1552_l
diff --git a/.jjconflict-side-1/src/time.ml b/.jjconflict-side-1/src/time.ml
deleted file mode 100644
index 3c5af371..00000000
--- a/.jjconflict-side-1/src/time.ml
+++ /dev/null
@@ -1,151 +0,0 @@
-let uint64_max = Int64.minus_one
-
-module Relative = struct
- type t = Int64.t
-
- let forever = uint64_max
- let zero = 0L
- let compare = Int64.unsigned_compare
- let min a b = if compare a b < 0 then a else b
- let max a b = if compare a b > 0 then a else b
-
- (* forever if either argument is forever or on overflow; otherwise a + b *)
- let add a b =
- if a = forever || b = forever then forever
- else
- let v = Int64.add a b in
- if compare v a < 0 then forever else v
-
- (* zero if a <= b, or forever if a is forever; otherwise a - b *)
- let sub a b =
- if compare a b <= 0 then zero
- else if a = forever then forever
- else Int64.sub a b
-
- let of_s s =
- let v = Int64.mul s 1_000_000L in
- if Int64.unsigned_div v 1_000_000L <> s then forever else v
-
- let bin = Bin.neint64
- let bin_nbo = Bin.beint64
-
- (* TODO should be in NBO here? *)
- let caqti =
- let encode v = Ok v in
- let decode v = Ok v in
- Caqti_type.custom ~encode ~decode Caqti_type.int64
-
- (* TODO
- reject negative / non-integer values
- cap value at 2^53 - 1 inclusive *)
- let jsont =
- let jsont =
- let forever_jsont =
- let dec s =
- match s with
- | "forever" -> forever
- | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
- in
- let enc _t = "forever" in
- Jsont.map ~dec ~enc Jsont.string
- in
- let num_jsont = Jsont.int64 in
- let enc t = if t = forever then forever_jsont else num_jsont in
- Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc ()
- in
- Jsont.Object.map ~kind:"RelativeTime" Fun.id
- |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id
- |> Jsont.Object.finish
-end
-
-module Absolute = struct
- type t = Int64.t
-
- let never = uint64_max
- let zero = 0L
- let compare = Int64.unsigned_compare
- let min a b = if compare a b < 0 then a else b
- let max a b = if compare a b > 0 then a else b
-
- (* zero if a >= b; never if b=never; otherwise b - a *)
- let diff a b =
- if compare a b >= 0 then zero
- else if b = never then never
- else Int64.sub b a
-
- (* never if either argument is never/forever or on overflow; otherwise t + d *)
- let add t d =
- if t = never || d = never then never
- else
- let v = Int64.add t d in
- if compare v t < 0 then never else v
-
- (* zero if t <= d, or never if t is never; otherwise t - d *)
- let sub t d =
- if compare t d <= 0 then zero
- else if t = never then never
- else Int64.sub t d
-
- let of_s s =
- let v = Int64.mul s 1_000_000L in
- if Int64.unsigned_div v 1_000_000L <> s then never else v
-
- let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s
-end
-
-module Timestamp = struct
- type t = Int64.t
-
- let never = uint64_max
- let zero = 0L
- let compare = Int64.unsigned_compare
-
- (* zero if a >= b; never if b=never; otherwise b - a *)
- let diff a b =
- if compare a b >= 0 then zero
- else if b = never then never
- else Int64.sub b a
-
- let of_s s =
- let v = Int64.mul s 1_000_000L in
- if Int64.unsigned_div v 1_000_000L <> s then never else v
-
- let to_s t =
- if t = never then None else Some (Int64.unsigned_div t 1_000_000L)
-
- let of_absolute a =
- if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L)
-
- let of_ptime v = v |> Absolute.of_ptime |> of_absolute
- let bin = Bin.neint64
- let bin_nbo = Bin.beint64
-
- let caqti =
- let encode v = Ok v in
- let decode v = Ok v in
- Caqti_type.custom ~encode ~decode Caqti_type.int64
-
- let jsont =
- let jsont =
- let never_jsont =
- let dec s =
- match s with
- | "never" -> never
- | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
- in
- let enc _t = "never" in
- Jsont.map ~dec ~enc Jsont.string
- in
- let num_jsont =
- Jsont.map
- ~dec:(fun n -> of_s n)
- ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s)
- Jsont.int64
- in
- let enc t = if t = never then never_jsont else num_jsont in
- Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc ()
- in
- Jsont.Object.map ~kind:"Timestamp" Fun.id
- |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id
- |> Jsont.Object.finish
-end
diff --git a/.jjconflict-side-1/src/time.mli b/.jjconflict-side-1/src/time.mli
deleted file mode 100644
index 180df904..00000000
--- a/.jjconflict-side-1/src/time.mli
+++ /dev/null
@@ -1,54 +0,0 @@
-module Relative : sig
- type t
-
- val forever : t
- val zero : t
- val compare : t -> t -> int
- val min : t -> t -> t
- val max : t -> t -> t
- val add : t -> t -> t
- val sub : t -> t -> t
- val of_s : int64 -> t
-
- (* - *)
- val bin : t Bin.t
- val bin_nbo : t Bin.t
- val caqti : t Caqti_type.t
- val jsont : t Jsont.t
-end
-
-module Absolute : sig
- type t
-
- val never : t
- val zero : t
- val compare : t -> t -> int
- val min : t -> t -> t
- val max : t -> t -> t
- val diff : t -> t -> Relative.t
- val add : t -> Relative.t -> t
- val sub : t -> Relative.t -> t
- val of_s : int64 -> t
- val of_ptime : Ptime.t -> t
-end
-
-module Timestamp : sig
- type t
-
- val never : t
- val zero : t
- val compare : t -> t -> int
- val diff : t -> t -> Relative.t
- val of_s : int64 -> t
-
- (* none if t = never *)
- val to_s : t -> int64 option
- val of_absolute : Absolute.t -> t
- val of_ptime : Ptime.t -> t
-
- (* - *)
- val bin : t Bin.t
- val bin_nbo : t Bin.t
- val caqti : t Caqti_type.t
- val jsont : t Jsont.t
-end
diff --git a/.jjconflict-side-1/src/timestamp.ml b/.jjconflict-side-1/src/timestamp.ml
deleted file mode 100644
index 1a942758..00000000
--- a/.jjconflict-side-1/src/timestamp.ml
+++ /dev/null
@@ -1 +0,0 @@
-include Time.Timestamp
diff --git a/.jjconflict-side-1/src/util.ml b/.jjconflict-side-1/src/util.ml
deleted file mode 100644
index c690a009..00000000
--- a/.jjconflict-side-1/src/util.ml
+++ /dev/null
@@ -1,62 +0,0 @@
-module Log_reporter = struct
- let detail_tag : string Logs.Tag.def =
- Logs.Tag.def "Detail tag" ~doc:"" Fmt.string
-
- let detail s = Logs.Tag.(empty |> add detail_tag s)
- let time_anchor = Ptime_clock.now () |> Ptime.to_span
-
- let color_of_log_level = function
- | Logs.App -> `White
- | Error -> `Red
- | Warning -> `Yellow
- | Info -> `Blue
- | Debug -> `Magenta
-
- let reporter : Logs.reporter =
- let open Fmt in
- let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%04.02f")) in
- let pp_header ppf v =
- let color = color_of_log_level (fst v) in
- let pp = styled (`Fg color) Logs.pp_header in
- pf ppf "%a" pp v
- in
- let pp_src_name =
- let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in
- fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v
- in
- let pp_detail = option (styled `Green (fmt " (%s)")) in
- let report src lvl ~over k msgf =
- let ppf =
- match lvl with
- | Logs.App -> stdout
- | Error | Warning | Info | Debug -> stderr
- in
- let k _ppf = over (); k () in
- let with_detail h tags k user_fmt =
- let detail = Option.bind tags (Logs.Tag.find detail_tag) in
- let timestamp =
- Ptime.sub_span (Ptime_clock.now ()) time_anchor
- |> Option.map Ptime.to_float_s
- |> Option.value ~default:0.
- in
- let k ppf = kpf k ppf "%a@." pp_detail detail in
- let k ppf = kpf k ppf user_fmt in
- kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h)
- pp_src_name src
- in
- msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
- in
- { report }
-
- (* TODO logs
- - vif shouldn't use/set the default reporter
- - Log.err all `Internal_server_error response *)
- let setup () =
- let level = Some Logs.Info in
- Logs.set_level ~all:false level;
- Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
- Logs.Src.set_level Logs.default level;
- Logs_threaded.enable ();
- Logs.set_reporter reporter;
- ()
-end
diff --git a/.jjconflict-side-1/test/auditor_public_key b/.jjconflict-side-1/test/auditor_public_key
deleted file mode 100644
index 4b97fccf..00000000
--- a/.jjconflict-side-1/test/auditor_public_key
+++ /dev/null
@@ -1 +0,0 @@
-A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0
diff --git a/.jjconflict-side-1/test/dune b/.jjconflict-side-1/test/dune
deleted file mode 100644
index 7e8b7438..00000000
--- a/.jjconflict-side-1/test/dune
+++ /dev/null
@@ -1,9 +0,0 @@
-(test
- (name test)
- (modules test)
- (libraries mte fmt))
-
-(test
- (name test_crypto)
- (modules test_crypto)
- (libraries mte fmt))
diff --git a/.jjconflict-side-1/test/offline_management.sh b/.jjconflict-side-1/test/offline_management.sh
deleted file mode 100755
index 119c46e0..00000000
--- a/.jjconflict-side-1/test/offline_management.sh
+++ /dev/null
@@ -1,58 +0,0 @@
-#!/bin/bash
-
-set -e
-
-a="/tmp/a.json"
-b="/tmp/b.json"
-
-url="http://localhost:3434"
-auditor_pub=$(<"./test/auditor_public_key")
-master_key="./default/master_offline_private_key"
-zero_euro="EUR:0.0"
-
-offline_tool() {
- dune exec offline -- "$@" > /dev/null
-}
-
-offline_tool download --output $a --url $url"/management/keys"
-offline_tool sign \
---master_key $master_key \
---input $a \
---output $b
-offline_tool upload --input $b --url $url"/management/keys"
-echo "[OK] /management/keys"
-
-offline_tool enable-auditor \
---master_key $master_key \
---output $b \
---auditor_url "auditor.example.com" \
---auditor_name "auditor example" \
---auditor_pub $auditor_pub \
---validity_start 0
-offline_tool upload --input $b --url $url"/management/auditors"
-echo "[OK] /management/auditors"
-
-offline_tool wire-fee \
---master_key $master_key \
---output $b \
---wire_method "xxx" \
---fee_start 0 \
---fee_end 99999999 \
---closing_fee $zero_euro \
---wire_fee $zero_euro
-offline_tool upload --input $b --url $url"/management/wire-fee"
-echo "[OK] /management/wire-fee"
-
-offline_tool global-fees \
---master_key $master_key \
---output $b \
---start_date 0 \
---end_date 99999999 \
---history_fee $zero_euro \
---account_fee $zero_euro \
---purse_fee $zero_euro \
---history_expiration 9999999 \
---purse_account_limit 1 \
---purse_timeout 9999999
-offline_tool upload --input $b --url $url"/management/global-fees"
-echo "[OK] /management/global-fees"
diff --git a/.jjconflict-side-1/test/test.ml b/.jjconflict-side-1/test/test.ml
deleted file mode 100644
index 58b19438..00000000
--- a/.jjconflict-side-1/test/test.ml
+++ /dev/null
@@ -1,110 +0,0 @@
-let () = Mirage_crypto_rng_unix.use_default ()
-
-let () =
- let priv = Mirage_crypto_pk.Rsa.generate ~bits:2048 () in
- let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in
- let () =
- let open Crypto.RsaPrivateKey in
- let priv' = priv |> to_octets |> of_octets |> Result.get_ok in
- assert (to_octets priv = to_octets priv')
- in
- let () =
- let open Crypto.RsaPublicKey in
- let pub' = pub |> to_octets |> of_octets |> Result.get_ok in
- assert (to_octets pub = to_octets pub')
- in
- ()
-
-let () =
- let open Api in
- let check jsont s =
- let encode v = encode jsont v |> Result.get_ok in
- let decode v = decode jsont v |> Result.get_ok in
- let ts = decode s in
- let s' = encode ts in
- let ts' = decode s' in
- let s'' = encode ts' in
- assert (String.equal s' s'')
- in
- let check_bad jsont s =
- let decode = decode jsont in
- assert (Result.is_error (decode s))
- in
- check Timestamp.jsont {|{"t_s": 123456780}|};
- check Timestamp.jsont {|{"t_s": "never"}|};
- check_bad Timestamp.jsont {|{"t_s": "123456780"}|};
- check_bad Timestamp.jsont {|{"t_s": "agagou"}|};
-
- (* CS not implemented *)
- check_bad DenominationKey.jsont
- {|{"cipher": "CS", "age_mask": 18, "cs_pub": "ouhagag"}|};
-
- (* TODO test with a valid rsa_pub value *)
- (* TODO handle "rsa pub_of_octets failure" correctly *)
- (* check_bad DenominationKey.jsont
- {|{"cipher": "RSA", "age_mask": 18, "rsa_pub": "agagouh"}|}; *)
- ()
-
-let () =
- let open Amount in
- let v =
- make ~sign:(Some Sign_plus) ~currency:"EUR" ~value:(Int64.of_int 25)
- ~fraction:(Int32.of_int 678)
- |> Result.get_ok
- in
- let s = to_string v in
- let v' = of_string s |> Result.get_ok in
- assert (v = v');
- let r = of_string {|~EUR:4.9|} in
- assert (Result.is_error r);
- let r = of_string {|+EUR:4.99999999999999999999999|} in
- assert (Result.is_error r);
- ()
-
-let () =
- let open Headers_lib.If_none_match in
- let ok_l =
- [
- "*";
- "\"foo\"";
- "W/\"foo\"";
- "\"foo\", \"bar\"";
- " , W/\"x\" , W/\"y\" , \"z\"";
- ", \"one\" , \"two\" , \"three\"";
- "W/\"a\" , ";
- "W/\"a\" , \"b\"";
- ]
- in
- let bad_l =
- [
- "";
- "foo";
- "W/foo";
- "W/\"unterminated";
- "\"foo\", W/";
- "* , \"bar\"";
- "\"a\" \"b\"";
- "W/\"a\" W/\"b\"";
- "\"fo\x7Fo\"";
- " W/\"a\"";
- "W/\"a\" ";
- ]
- in
- let check_ok input = assert (Result.is_ok (parse input)) in
- let check_bad input = assert (Result.is_error (parse input)) in
- List.iter check_ok ok_l;
- List.iter check_bad bad_l;
-
- ()
-
-let () =
- let round_trip s =
- let s' = s |> B32.encode |> B32.decode |> Result.get_ok in
- assert (s = s')
- in
- let s = String.init 0xff Char.chr in
- round_trip s;
- let s_l = List.init 0x0f (fun i -> String.init i Char.chr) in
- List.iter round_trip s_l;
-
- ()
diff --git a/.jjconflict-side-1/test/test_crypto.ml b/.jjconflict-side-1/test/test_crypto.ml
deleted file mode 100644
index 404db053..00000000
--- a/.jjconflict-side-1/test/test_crypto.ml
+++ /dev/null
@@ -1,110 +0,0 @@
-(* Test vectors taken from GNUnet:
- https://git.gnunet.org/gnunet/gnunet/file/src/cli/util/crypto-test-vectors.json.html *)
-
-let encode = B32.encode
-let decode s = B32.decode s |> Result.get_ok
-
-let () =
- (* hash *)
- let input = "91JPRV3F5GG4EKJNDSJQ8" in
- let expected =
- "D0R24RZ1TPASVQ2NY56CT8AJDYZE9ZGDB0GVZ05E9D4YGZQW2RC5YFPQ0Q86EPW836DY7VYQTNFFJT3ZR2K508F4JVS5JNJKYN2MMFR"
- in
- let output =
- input |> decode |> Hash.H64.hash |> Hash.H64.to_octets |> encode
- in
- assert (output = expected);
-
- ()
-
-let () =
- (* eddsa_key_derivation *)
- let pub = "3M9KK1WSNM1RTY5P72HKFA264V4B7MVHVJ08Y90CV06DYHV8XPP0" in
- let priv = "8QC2VNF8443S5KPNKMB4XMV58BTHWAKZ7SVW5WG3KRB37567XS90" in
- let pub' =
- let open Crypto in
- priv
- |> decode
- |> EddsaPrivateKey.of_octets
- |> Result.get_ok
- |> EddsaPrivateKey.pub_of_priv
- |> EddsaPublicKey.to_octets
- |> encode
- in
- assert (pub = pub');
-
- ()
-
-let () =
- (* eddsa_signing *)
- let priv = "5077XJR9AMH4T97ACKFBVBJD0KFENHPV66B2Y1JBSKXBJKNZJ4E0" in
- let pub = "6E2F03JJ8AEDANTTZZ4SBZDFEEZSF8A9DVGTS6VFBCVZQYQ46RRG" in
- let data = "00000300000000000000" in
- let sig_ =
- "XCNJGJ96WPDH60YVMH6C74NGQSGJE3BC1TYMGX6BHY5DMZZZKTB373QTXJ507K5EBSG9YS2EYKHCX3ATRQ6P5MY9MXC4ZB1XSZ2X23G"
- in
- let open Crypto in
- let msg = decode data in
- let eddsa_priv =
- priv |> decode |> EddsaPrivateKey.of_octets |> Result.get_ok
- in
- let sig_' =
- EddsaSignature.sign ~key:eddsa_priv msg
- |> EddsaSignature.to_octets
- |> encode
- in
- assert (sig_ = sig_');
- let eddsa_pub = pub |> decode |> EddsaPublicKey.of_octets |> Result.get_ok in
- let eddsa_sig = sig_ |> decode |> EddsaSignature.of_octets |> Result.get_ok in
- let () =
- EddsaSignature.verify ~key:eddsa_pub eddsa_sig ~msg |> Result.get_ok
- in
-
- ()
-
-let () =
- (* kdf *)
- let salt = "94KPT83PCNS7J83KC5P78Y8" in
- let ikm = "94KPT83MD1JJ0WV5CDS6AX10D5Q70XBM41NPAY90DNGQ8SBJD5GPR" in
- let ctx =
- "94KPT83141HPYVKMCNW78833D1TPWTSC41GPRWVF41NPWVVQDRG62WS04XMPWSKF4WG6JVH0EHM6A82J8S1G"
- in
- let out_len = 64 in
- let out =
- "GTMR4QT05Z9WF5HKVG0WK9RPXGHSMHJNW377G9GJXCA8B0FEKPF4D27RJMSJZYWSQNTBJ5EYVV7ZW18B48Z0JVJJ80RHB706Y96Q358"
- in
-
- let xts = salt |> decode in
- let ikm = ikm |> decode in
- let ctx = ctx |> decode in
- let okm = Crypto.FDH_RSA.Kdf.kdf ~xts ~ikm ~ctx ~len:out_len in
- let okm = okm |> encode in
- assert (okm = out);
-
- ()
-
-let () =
- (* rsa_blind_signing *)
- (* rsa_private_key data is given in gcrypt sexpr format.. *)
- let message_hash =
- "XKQMJ4CNTXBFE1V2WR6JS063J7PZQE4XMB5JH3RS5X0THQ1JQSQ69Y7KDBC9TYRJEZH48MEPY2SF4QHQ4VHXC0YQX5935MQEGP0AX6R"
- in
- let rsa_public_key =
- "040000YRN1NVJ68RS6RJF52PGRCQG19ZKWQPSTJX2G7ZDCKSZFE2VW3HHA81YF5C639JHJF5TX8YTEE2FW2WQCG1PTKNBSPPJEJGA032CN3E8QZ27VWY0K6JFT8ZSYWRH2SKDMXW56A4QKY46JJBWJ6T0ZRVBW6S1HTHXVE2RW8MXRW5T801077MDY13N5F8Z1JZVKBJ06TK3S0YPEDBXK0VEHRHEQJ5X5XYKR4KQTFAZNBMKXY8836VCHBXTK4YNX6AJ1CK29SMJH3Z3QRM16A2TNQGFR0HSMV446BF7FMT2E379ZAT5ST4G3BM2NWZYW545S2SW5MG5S6M88XZZ7SKFD48YVXNZ205GGSEYJPVBMR76WG4ZG30WBCPC1N54XE12RMAG81D8C09WG22PKGGDHYXX68N04002"
- in
- let blinding_key_secret =
- "3SWF49XZPHQMENTSBZQR7Z0B8ZSZ2JRARE79Q4VXZMQ7W6QABXMG"
- in
- let blinded_message =
- "3KHKZJZ30ABB4E56MA2V0EQWGCWH0QQG9P2ZHYHR186C5HZXJMM4N9WXAQTKS94QSV9Y17GGNXN5MB1PZZFG7Q0FY88QPKKRG4MYCPSMTZK5W59R0MJVNJ4P4AQM96TDG5W7RV8GSNR1QQZ1GNHW3CX6D6ZRTMXB2NKB5SSYTDJS79F5ZFBRZ4HVED9JBBPWSR79KVV5QQ4APBGHBCKGMF9NJJS53A1BVYHDEVYAGFYF2SNEP827ZP50FKJ5GKGV8NQ15ESEZ69AT7GJG0T3TZVENY2YN9CVR98W3BKEZ53J7VTANARG8SJS8AMJQ7S23P5HRJ7XE9KTNRNXKH49MXV9JHHYE5535N7AGWEKR47SBCGNF44Z7XJ9RV5BQV12ZRJKN4HBZQHDNCMH3QKX9Z6G64"
- in
- let open Crypto in
- let msg = message_hash |> decode in
- let pub =
- rsa_public_key |> decode |> RsaPublicKey.of_octets |> Result.get_ok
- in
- let bks = blinding_key_secret |> decode in
- let s = FDH_RSA.rsa_blind pub ~bks ~msg |> encode in
- assert (s = blinded_message);
-
- ()
diff --git a/.jjconflict-side-1/tools/dbinit.sh b/.jjconflict-side-1/tools/dbinit.sh
deleted file mode 100755
index 4d74bc9a..00000000
--- a/.jjconflict-side-1/tools/dbinit.sh
+++ /dev/null
@@ -1,100 +0,0 @@
-#!/bin/bash
-
-# TODO
-# use specific commit
-
-# usage:
-# `create_database`
-# create a `taler-exchange` database
-# `fetch`
-# fetch all *.sql and *.sql.in files from GNU Taler exchange repository (latest commit)
-# `init`
-# initialize taler-exchange database (create tables, ...)
-# `taler-exchange` database must already be created
-#
-
-
-set -e
-
-taler_repo_url="https://git-www.taler.net/exchange.git/"
-
-tmp_dir="/tmp/taler_exchange"
-out_dir="./_taler_exchange_sql"
-init_sql="${out_dir}/init.sql"
-drop_sql="${out_dir}/drop.sql"
-
-# psql parameter
-host="localhost"
-port=5432
-username="mte"
-dbname="taler-exchange"
-
-fetch() {
- git clone --depth 1 $taler_repo_url $tmp_dir
-}
-
-process() {
- source_dir="${tmp_dir}/src/exchangedb"
- sql_in_files=(
- "procedures.sql"
- "exchange-0002.sql"
- "exchange-0003.sql"
- "exchange-0004.sql"
- )
- for file in "${sql_in_files[@]}"; do
- file_in="${source_dir}/${file}.in"
- file_out="${source_dir}/${file}"
- gcc -E -P -undef -I "$source_dir" - < "$file_in" \
- 2>/dev/null \
- > "$file_out"
- done
- # order is important
- files=(
- "versioning.sql"
- "exchange-0001.sql"
- "exchange-0002.sql"
- "exchange-0003.sql"
- "exchange-0004.sql"
- "exchange-0005.sql"
- "procedures.sql"
- )
- mkdir -p "$out_dir"
- cat "${source_dir}/drop.sql" > "$drop_sql"
- echo "" > "$init_sql"
- for file in "${files[@]}"; do
- cat "${source_dir}/${file}" >> "$init_sql"
- done
-}
-
-# ? "NOTICE: function xxx() does not exist, skipping"
-init() {
- psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$init_sql
-}
-
-drop_schema() {
- psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$drop_sql
-}
-
-create_database() {
- createdb --host=$host --port=$port --username=$username --password $dbname
-}
-
-drop_database() {
- dropdb --host=$host --port=$port --username=$username --password $dbname
-}
-
-if [[ $# -eq 0 ]]; then
- echo "no argument" >&2
- exit 1
-fi
-
-cmd=$1
-case "$cmd" in
- fetch) fetch "$@"; exit 0;;
- process) process "$@"; exit 0;;
- init) init "$@"; exit 0;;
- drop_schema) drop_schema "$@"; exit 0;;
- create_database) create_database "$@"; exit 0;;
- drop_database) drop_database "$@"; exit 0;;
- *) echo "Unknown command: $cmd" >&2; exit 1;;
-esac
diff --git a/.jjconflict-side-1/tools/dune b/.jjconflict-side-1/tools/dune
deleted file mode 100644
index 7b747b57..00000000
--- a/.jjconflict-side-1/tools/dune
+++ /dev/null
@@ -1,16 +0,0 @@
-(executable
- (public_name offline)
- (name offline)
- (modules offline offline_impl)
- (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
-
-(executable
- (public_name gen_registry_files)
- (name gen_registry_files)
- (modules gen_registry_files)
- (libraries recfile_parser bos fmt))
-
-(library
- (name recfile_parser)
- (modules recfile_parser)
- (libraries angstrom bos cmdliner fmt))
diff --git a/.jjconflict-side-1/tools/gen_registry_files.ml b/.jjconflict-side-1/tools/gen_registry_files.ml
deleted file mode 100644
index ebaae034..00000000
--- a/.jjconflict-side-1/tools/gen_registry_files.ml
+++ /dev/null
@@ -1,89 +0,0 @@
-module Signature_code = struct
- type t = {
- number: int32;
- name: string;
- comment: string;
- }
-end
-
-let parse_signature_codes records =
- records
- |> List.filter_map (fun l ->
- match l with
- | a :: b :: c :: _ -> (
- let open Recfile_parser in
- match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
- | false -> None
- | true ->
- Some
- Signature_code.
- {
- number= Int32.of_int (int_of_string a.v);
- name= String.lowercase_ascii b.v;
- comment= c.v;
- })
- | _ -> None)
- |> List.filter (fun v -> v.Signature_code.number >= 1000_l)
-
-let pp_taler_signatures_ml ppf purposes =
- let header =
- {|(* This file was generated from the GANA database:
- https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|}
- in
- let pp ppf Signature_code.{ number; name; comment } =
- Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
- in
- Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
- ()
-
-let download ~tmp ~url =
- let open Bos in
- let res =
- OS.Cmd.run
- Cmd.(
- v "curl" % "--silent" % "--show-error" % "-o" % tmp % "-X" % "GET" % url)
- in
- match res with
- | Error (`Msg s) -> Fmt.failwith "download failure: %s" s
- | Ok () -> ()
-
-let signatures ~output =
- let url =
- "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
- in
- let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
- download ~tmp:(Fpath.to_string tmp_file) ~url;
- let content = Bos.OS.File.read tmp_file |> Result.get_ok in
- match Recfile_parser.parse content with
- | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
- | Ok records ->
- let purposes = parse_signature_codes records in
- let module_content = Fmt.str "%a" pp_taler_signatures_ml purposes in
- Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok
-
-(* --- *)
-open Cmdliner
-open Cmdliner.Term.Syntax
-
-let output =
- let doc = "output file" in
- Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
-
-let signatures_cmd =
- let doc =
- "Generate taler_signatures.ml from GANA gnunet-signatures registry"
- in
- Cmd.make (Cmd.info "signatures" ~doc)
- @@
- let+ output = output in
- signatures ~output
-
-let cli =
- let info =
- let doc = "Tool to generate OCaml module from GANA registries" in
- Cmd.info "gen_registry_files" ~doc
- in
- Cmd.group info [ signatures_cmd ]
-
-let main () = Cmd.eval cli
-let () = if !Sys.interactive then () else exit (main ())
diff --git a/.jjconflict-side-1/tools/offline.ml b/.jjconflict-side-1/tools/offline.ml
deleted file mode 100644
index 461492c7..00000000
--- a/.jjconflict-side-1/tools/offline.ml
+++ /dev/null
@@ -1,310 +0,0 @@
-(* TODO
- all management operations:
- /management/wire
- /management/wire/disable
-
- /management/aml-officers
- -> /aml
- /management/partners
- -> /wads *)
-
-open Cmdliner
-open Cmdliner.Term.Syntax
-open Offline_impl
-
-module Arg = struct
- include Arg
-
- (* in seconds *)
- let timestamp =
- let parser s =
- match int_of_string_opt s with
- | None -> Error "not an int"
- | Some n -> Ok (Time.Timestamp.of_s (Int64.of_int n))
- in
- let pp fmt t =
- match Time.Timestamp.to_s t with
- | None -> Fmt.pf fmt "never"
- | Some s -> Fmt.pf fmt "%Ld" s
- in
- Arg.Conv.make ~docv:"timestamp argument" ~parser ~pp ()
-
- (* in seconds *)
- let relative_time =
- let parser s =
- match int_of_string_opt s with
- | None -> Error "not an int"
- | Some s -> Ok (Time.Relative.of_s (Int64.of_int s))
- in
- let pp fmt d =
- let t = Time.Timestamp.of_absolute Time.Absolute.(add zero d) in
- match Time.Timestamp.to_s t with
- | None -> Fmt.pf fmt "never"
- | Some s -> Fmt.pf fmt "%Ld" s
- in
- Arg.Conv.make ~docv:"relative time argument" ~parser ~pp ()
-
- let b32 =
- let pp fmt v = Fmt.pf fmt "%s" (B32.encode v) in
- Arg.Conv.make ~docv:"Crockford's Base32 encoded argument" ~parser:B32.decode
- ~pp ()
-
- let amount =
- Arg.Conv.make ~docv:"amount argument" ~parser:Amount.of_string ~pp:Amount.pp
- ()
-
- let eddsa_pub =
- let parser s = Crypto.EddsaPublicKey.of_b32 s in
- let pp fmt key =
- let s = Crypto.EddsaPublicKey.to_b32 key in
- Fmt.pf fmt "%s" s
- in
- Arg.Conv.make ~docv:"eddsa public key argument" ~parser ~pp ()
-end
-
-let master_key =
- let doc = "Master offline Eddsa private key file." in
- Arg.(required & opt (some file) None & info [ "master_key" ] ~doc)
-
-let input =
- let doc = "input file" in
- Arg.(required & opt (some file) None & info [ "i"; "input" ] ~doc)
-
-let output =
- let doc = "output file" in
- Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
-
-let url =
- let doc = "url" in
- Arg.(required & opt (some string) None & info [ "url" ] ~doc)
-
-let setup_cmd =
- let doc =
- "Generate offline master keys, write private and public key to file"
- in
- let output =
- let doc = "private key output file" in
- Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
- in
- let output_pubkey =
- let doc =
- "public key output file, default to --output parameter with a \".pub\" \
- extension"
- in
- Arg.(value & opt (some filepath) None & info [ "output-pubkey" ] ~doc)
- in
- Cmd.make (Cmd.info "setup" ~doc)
- @@
- let+ output = output and+ output_pubkey = output_pubkey in
- let output_pubkey = Option.value ~default:(output ^ ".pub") output_pubkey in
- setup ~output ~output_pubkey
-
-let download_cmd =
- let doc =
- "use curl to send a GET request to --url, write response body to --output"
- in
- Cmd.make (Cmd.info "download" ~doc)
- @@
- let+ output = output and+ url = url in
- download ~output ~url
-
-let upload_cmd =
- let doc =
- "use curl to send a POST request to --url, with request body set to \
- --input file content"
- in
- Cmd.make (Cmd.info "upload" ~doc)
- @@
- let+ input = input and+ url = url in
- upload ~input ~url
-
-let sign_cmd =
- let doc = "Sign FutureKeysResponse." in
- Cmd.make (Cmd.info "sign" ~doc)
- @@
- let+ input = input and+ output = output and+ master_key = master_key in
- sign ~input ~output ~master_key
-
-let revoke_denom_cmd =
- let doc = "Revoke denomination." in
- let h_denom =
- let doc = "hash of denomination public key" in
- Arg.(required & pos 0 (some string) None & info [] ~doc)
- in
- Cmd.make (Cmd.info "revoke-denom" ~doc)
- @@
- let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
- revoke_denom ~output ~master_key ~h_denom
-
-let revoke_signkey_cmd =
- let doc = "Revoke signkey." in
- let signkey =
- let doc = "public signing key" in
- Arg.(required & pos 0 (some eddsa_pub) None & info [] ~doc)
- in
- Cmd.make (Cmd.info "revoke-signkey" ~doc)
- @@
- let+ output = output and+ master_key = master_key and+ signkey = signkey in
- revoke_signkey ~output ~master_key ~signkey
-
-let enable_auditor_cmd =
- let doc = "Enable auditor." in
- let auditor_url =
- Arg.(required & opt (some string) None & info [ "auditor_url" ])
- in
- let auditor_name =
- Arg.(required & opt (some string) None & info [ "auditor_name" ])
- in
- let auditor_pub =
- Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
- in
- let validity_start =
- Arg.(required & opt (some timestamp) None & info [ "validity_start" ])
- in
- Cmd.make (Cmd.info "enable-auditor" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ auditor_url = auditor_url
- and+ auditor_name = auditor_name
- and+ auditor_pub = auditor_pub
- and+ validity_start = validity_start in
- enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
- ~validity_start
-
-let disable_auditor_cmd =
- let doc = "Disable auditor." in
- let auditor_pub =
- Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
- in
- let validity_end =
- Arg.(required & opt (some timestamp) None & info [ "validity_end" ])
- in
- Cmd.make (Cmd.info "disable-auditor" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ auditor_pub = auditor_pub
- and+ validity_end = validity_end in
- disable_auditor ~output ~master_key ~auditor_pub ~validity_end
-
-let wire_fee_cmd =
- let doc = "Provides wire fee configuration." in
- let wire_method =
- Arg.(required & opt (some string) None & info [ "wire_method" ])
- in
- let fee_start =
- Arg.(required & opt (some timestamp) None & info [ "fee_start" ])
- in
- let fee_end =
- Arg.(required & opt (some timestamp) None & info [ "fee_end" ])
- in
- let closing_fee =
- Arg.(required & opt (some amount) None & info [ "closing_fee" ])
- in
- let wire_fee =
- Arg.(required & opt (some amount) None & info [ "wire_fee" ])
- in
- Cmd.make (Cmd.info "wire-fee" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ wire_method = wire_method
- and+ fee_start = fee_start
- and+ fee_end = fee_end
- and+ closing_fee = closing_fee
- and+ wire_fee = wire_fee in
- Offline_impl.wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end
- ~closing_fee ~wire_fee
-
-let global_fees_cmd =
- let doc = "Provides global fee configuration." in
- let start_date =
- Arg.(required & opt (some timestamp) None & info [ "start_date" ])
- in
- let end_date =
- Arg.(required & opt (some timestamp) None & info [ "end_date" ])
- in
- let history_fee =
- Arg.(required & opt (some amount) None & info [ "history_fee" ])
- in
- let account_fee =
- Arg.(required & opt (some amount) None & info [ "account_fee" ])
- in
- let purse_fee =
- Arg.(required & opt (some amount) None & info [ "purse_fee" ])
- in
- let history_expiration =
- Arg.(
- required & opt (some relative_time) None & info [ "history_expiration" ])
- in
- let purse_account_limit =
- Arg.(required & opt (some int) None & info [ "purse_account_limit" ])
- in
- let purse_timeout =
- Arg.(required & opt (some relative_time) None & info [ "purse_timeout" ])
- in
- Cmd.make (Cmd.info "global-fees" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ start_date = start_date
- and+ end_date = end_date
- and+ history_fee = history_fee
- and+ account_fee = account_fee
- and+ purse_fee = purse_fee
- and+ history_expiration = history_expiration
- and+ purse_account_limit = purse_account_limit
- and+ purse_timeout = purse_timeout in
- global_fees ~output ~master_key ~start_date ~end_date ~history_fee
- ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
- ~purse_timeout
-
-let drain_cmd =
- let doc =
- "Drain profits from the exchange. The actual drain requires running the \
- `taler-exchange-drain` tool."
- in
- let debit_account_section =
- Arg.(required & opt (some string) None & info [ "debit_account_section" ])
- in
- let credit_payto_uri =
- Arg.(required & opt (some string) None & info [ "credit_payto_uri" ])
- in
- let wtid = Arg.(required & opt (some b32) None & info [ "wtid" ]) in
- let date = Arg.(required & opt (some timestamp) None & info [ "date" ]) in
- let amount = Arg.(required & opt (some amount) None & info [ "amount" ]) in
- Cmd.make (Cmd.info "drain" ~doc)
- @@
- let+ output = output
- and+ master_key = master_key
- and+ debit_account_section = debit_account_section
- and+ credit_payto_uri = credit_payto_uri
- and+ wtid = wtid
- and+ date = date
- and+ amount = amount in
- drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid ~date
- ~amount
-
-let cli =
- let info =
- let doc = "MTE Offline CLI tool" in
- Cmd.info "mte-offline" ~doc
- in
- Cmd.group info
- [
- setup_cmd;
- download_cmd;
- sign_cmd;
- upload_cmd;
- revoke_denom_cmd;
- revoke_signkey_cmd;
- enable_auditor_cmd;
- disable_auditor_cmd;
- wire_fee_cmd;
- global_fees_cmd;
- drain_cmd;
- ]
-
-let main () = Cmd.eval_result cli
-let () = if !Sys.interactive then () else exit (main ())
diff --git a/.jjconflict-side-1/tools/offline_impl.ml b/.jjconflict-side-1/tools/offline_impl.ml
deleted file mode 100644
index 9a851fa5..00000000
--- a/.jjconflict-side-1/tools/offline_impl.ml
+++ /dev/null
@@ -1,378 +0,0 @@
-open Syntax
-open Hash
-
-module Future_keys = struct
- open Crypto
- open Api
-
- let verify =
- let verify_future_denom ~sm_denom_pub
- 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 h_denom_pub =
- DenominationHash.hash (DenominationKey.to_octets denom_pub)
- in
- let h_section_name = Hash.Cstring.H64.hash section_name in
- let anchor_time = stamp_start in
- let duration_withdraw =
- Timestamp.diff stamp_start stamp_expire_withdraw
- in
- let open Signatures.DenominationKeyAnnouncement in
- verify_f
- ~f:(EddsaSignature.verify ~key:sm_denom_pub)
- denom_secmod_sig
- { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
- in
- let verify_future_signkey ~sm_signkey_pub
- FutureSignKey.
- { key; stamp_start; stamp_expire; stamp_end= _; signkey_secmod_sig } =
- let exchange_pub = key in
- let anchor_time = stamp_start in
- let duration = Timestamp.diff stamp_start stamp_expire in
- let open Signatures.SigningKeyAnnouncement in
- verify_f
- ~f:(EddsaSignature.verify ~key:sm_signkey_pub)
- signkey_secmod_sig
- { exchange_pub; anchor_time; duration }
- in
- fun our_master_public_key
- FutureKeysResponse.
- {
- future_denoms;
- future_signkeys;
- master_pub;
- denom_secmod_public_key;
- signkey_secmod_public_key;
- }
- ->
- let* () =
- match master_pub = our_master_public_key with
- | false ->
- Fmt.error
- "master public key of the future key response does not match ours"
- | true -> Ok ()
- in
- let* () =
- list_iter
- (verify_future_denom ~sm_denom_pub:denom_secmod_public_key)
- future_denoms
- in
- let* () =
- list_iter
- (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key)
- future_signkeys
- in
- Ok ()
-
- let make =
- let denom_signature ~master_key
- 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 octets = DenominationKey.to_octets denom_pub in
- let h_denom_pub = DenominationHash.hash octets in
- let master_sig =
- let open Signatures.DenominationKeyValidity in
- let master = EddsaPrivateKey.(pub_of_priv master_key) in
- sign_f
- ~f:(EddsaSignature.sign ~key:master_key)
- {
- master;
- start= stamp_start;
- expire_withdraw= stamp_expire_withdraw;
- expire_spend= stamp_expire_deposit;
- expire_legal= stamp_expire_legal;
- value;
- fee_withdraw;
- fee_deposit;
- fee_refresh;
- fee_refund;
- denom_hash= h_denom_pub;
- }
- in
- DenomSignature.{ h_denom_pub; master_sig }
- in
- let signkey_signature ~master_key
- FutureSignKey.
- { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
- let master_sig =
- let open Signatures.ExchangeSigningKeyValidity in
- sign_f
- ~f:(EddsaSignature.sign ~key:master_key)
- {
- start= stamp_start;
- expire= stamp_expire;
- end_= stamp_end;
- signkey_pub= key;
- }
- in
- SignKeySignature.{ key; master_sig }
- in
- fun ~master_key
- FutureKeysResponse.
- {
- future_denoms;
- future_signkeys;
- master_pub= _;
- denom_secmod_public_key= _;
- signkey_secmod_public_key= _;
- }
- ->
- let denom_sigs = List.map (denom_signature ~master_key) future_denoms in
- let signkey_sigs =
- List.map (signkey_signature ~master_key) future_signkeys
- in
- MasterSignatures.{ denom_sigs; signkey_sigs }
-end
-
-(* -- *)
-
-let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_err_msg
-
-let write_file fname content =
- Bos.OS.File.write (Fpath.v fname) content |> unwrap_err_msg
-
-let read_master_key_file filename =
- let* master_key = read_file filename in
- Crypto.EddsaPrivateKey.of_octets master_key
-
-let download ~output ~url =
- let open Bos in
- OS.Cmd.run
- Cmd.(
- v "curl"
- % "--silent"
- % "--show-error"
- % "-o"
- % output
- % "-X"
- % "GET"
- % url)
- |> unwrap_err_msg
-
-let upload ~input ~url =
- let open Bos in
- OS.Cmd.run
- Cmd.(
- v "curl"
- % "--silent"
- % "-i"
- % "-X"
- % "POST"
- % "-H"
- % "Content-Type: application/json"
- % "--data"
- % ("@" ^ input)
- % url)
- |> unwrap_err_msg
-
-let setup ~output ~output_pubkey =
- Mirage_crypto_rng_unix.use_default ();
- let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
- let priv_data = Mirage_crypto_ec.Ed25519.priv_to_octets priv in
- let* () = write_file output priv_data in
- let pub_data = Mirage_crypto_ec.Ed25519.pub_to_octets pub |> B32.encode in
- let* () = write_file output_pubkey pub_data in
- Ok ()
-
-let sign ~master_key ~input ~output =
- let open Crypto in
- let* master_key = read_master_key_file master_key in
- let* input = read_file input in
- let master_pub = EddsaPrivateKey.pub_of_priv master_key in
- let* future_keys_response = Api.decode Api.FutureKeysResponse.jsont input in
- let* () = Future_keys.verify master_pub future_keys_response in
- let master_signatures = Future_keys.make ~master_key future_keys_response in
- let* s = Api.encode Api.MasterSignatures.jsont master_signatures in
- let* () = write_file output s in
- Ok ()
-
-let revoke_denom ~output ~master_key ~h_denom =
- let* key = read_master_key_file master_key in
- let* h_denom_pub = DenominationHash.of_b32 h_denom in
- let denom_revoke =
- let master_sig =
- let open Signatures.MasterDenominationKeyRevocation in
- sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub }
- in
- Api.DenomRevocationSignature.{ master_sig }
- in
- let* s = Api.encode Api.DenomRevocationSignature.jsont denom_revoke in
- let* () = write_file output s in
- Ok ()
-
-let revoke_signkey ~output ~master_key ~signkey =
- let* key = read_master_key_file master_key in
- let signkey_revoke =
- let master_sig =
- let open Signatures.MasterSigningKeyRevocation in
- sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey }
- in
- Api.SignkeyRevocationSignature.{ master_sig }
- in
- let* s = Api.encode Api.SignkeyRevocationSignature.jsont signkey_revoke in
- let* () = write_file output s in
- Ok ()
-
-let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
- ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
- ~purse_timeout =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let* purse_account_limit =
- match
- purse_account_limit >= 0
- && purse_account_limit <= Int32.to_int Int32.max_int
- with
- | false -> Error "invalid purse_account_limit value"
- | true -> Ok (Int32.of_int purse_account_limit)
- in
- let master_sig =
- let open Signatures.GlobalFees in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- }
- in
- let global_fees =
- Api.GlobalFees.
- {
- start_date;
- end_date;
- purse_timeout;
- history_expiration;
- history_fee;
- account_fee;
- purse_fee;
- purse_account_limit;
- master_sig;
- }
- in
- let* s = Api.encode Api.GlobalFees.jsont global_fees in
- let* () = write_file output s in
- Ok ()
-
-let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
- ~validity_start =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig =
- let open Signatures.MasterAddAuditor in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- start_date= validity_start;
- auditor_pub;
- h_auditor_url= Hash.Cstring.H64.hash auditor_url;
- }
- in
- let v =
- Api.AuditorSetupMessage.
- { auditor_url; auditor_name; auditor_pub; master_sig; validity_start }
- in
- let* s = Api.encode Api.AuditorSetupMessage.jsont v in
- let* () = write_file output s in
- Ok ()
-
-let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig =
- let open Signatures.MasterDelAuditor in
- sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
- in
- let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in
- let* s = Api.encode Api.AuditorTeardownMessage.jsont v in
- let* () = write_file output s in
- Ok ()
-
-let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
- ~wire_fee =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig_wire =
- let open Signatures.MasterWireFee in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- h_wire_method= Hash.Cstring.H64.hash wire_method;
- start_date= fee_start;
- end_date= fee_end;
- closing_fee;
- wire_fee;
- }
- in
- let v =
- Api.WireFeeSetupMessage.
- {
- wire_method;
- fee_start;
- fee_end;
- closing_fee;
- wire_fee;
- master_sig_wire;
- }
- in
- let* s = Api.encode Api.WireFeeSetupMessage.jsont v in
- let* () = write_file output s in
- Ok ()
-
-let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid
- ~date ~amount =
- let open Crypto in
- let* key = read_master_key_file master_key in
- let master_sig =
- let open Signatures.MasterDrainProfit in
- sign_f ~f:(EddsaSignature.sign ~key)
- {
- wtid;
- date;
- amount;
- h_section= Hash.Cstring.H64.hash debit_account_section;
- h_payto= FullPaytoHash.hash credit_payto_uri;
- }
- in
- let v =
- Api.DrainProfitsMessage.
- {
- debit_account_section;
- credit_payto_uri;
- wtid;
- master_sig;
- date;
- amount;
- }
- in
- let* s = Api.encode Api.DrainProfitsMessage.jsont v in
- let* () = write_file output s in
- Ok ()
diff --git a/.jjconflict-side-1/tools/recfile_parser.ml b/.jjconflict-side-1/tools/recfile_parser.ml
deleted file mode 100644
index 94882a2f..00000000
--- a/.jjconflict-side-1/tools/recfile_parser.ml
+++ /dev/null
@@ -1,51 +0,0 @@
-(* very rudimentary recfile parser
- https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
-
-open Angstrom
-
-type field = {
- k: string;
- v: string;
-}
-
-type record = field list
-
-let newline = char '\n'
-let is_newline = function '\n' -> true | _ -> false
-
-let field_name =
- let first_char =
- satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
- in
- let subsequent_char =
- satisfy (function
- | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
- | _ -> false)
- in
- lift2
- (fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
- first_char (many subsequent_char)
-
-(* todo handle '\' escape and '+' on next line *)
-let field_value = take_till is_newline <* newline
-
-let field =
- let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
- let blanks = skip_many1 blank in
- lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
-
-let blank = newline *> return ()
-let comment = (char '#' *> take_till is_newline <* newline) *> return ()
-let record = many1 field
-
-let records =
- let sep =
- (* at least one blank line *)
- skip_many comment *> blank *> skip_many (comment <|> blank)
- in
- sep_by1 sep record
-
-let recfile : record list t =
- skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
-
-let parse s = parse_string ~consume:All recfile s
diff --git a/.jjconflict-base-0/.ocamlformat b/.ocamlformat
similarity index 100%
rename from .jjconflict-base-0/.ocamlformat
rename to .ocamlformat
diff --git a/.jjconflict-base-0/LICENSE b/LICENSE
similarity index 100%
rename from .jjconflict-base-0/LICENSE
rename to LICENSE
diff --git a/README b/README
deleted file mode 100644
index 5be01972..00000000
--- a/README
+++ /dev/null
@@ -1,11 +0,0 @@
-This commit was made by jj, https://jj-vcs.dev/.
-The commit contains file conflicts, and therefore looks wrong when used with plain
-Git or other tools that are unfamiliar with jj.
-
-The .jjconflict-* directories represent the different inputs to the conflict.
-For details, see
-https://docs.jj-vcs.dev/prerelease/git-compatibility/#format-mapping-details
-
-If you see this file in your working copy, it probably means that you used a
-regular `git` command to check out a conflicted commit. Use `jj abandon` to
-recover.
diff --git a/.jjconflict-base-0/default/assets/mte.conf b/default/assets/mte.conf
similarity index 100%
rename from .jjconflict-base-0/default/assets/mte.conf
rename to default/assets/mte.conf
diff --git a/.jjconflict-base-0/default/assets/privacy/en/0.md b/default/assets/privacy/en/0.md
similarity index 100%
rename from .jjconflict-base-0/default/assets/privacy/en/0.md
rename to default/assets/privacy/en/0.md
diff --git a/.jjconflict-base-0/default/assets/privacy/en/0.txt b/default/assets/privacy/en/0.txt
similarity index 100%
rename from .jjconflict-base-0/default/assets/privacy/en/0.txt
rename to default/assets/privacy/en/0.txt
diff --git a/.jjconflict-base-0/default/assets/terms/en/0.md b/default/assets/terms/en/0.md
similarity index 100%
rename from .jjconflict-base-0/default/assets/terms/en/0.md
rename to default/assets/terms/en/0.md
diff --git a/.jjconflict-base-0/default/assets/terms/en/0.txt b/default/assets/terms/en/0.txt
similarity index 100%
rename from .jjconflict-base-0/default/assets/terms/en/0.txt
rename to default/assets/terms/en/0.txt
diff --git a/.jjconflict-base-0/default/master_offline_private_key b/default/master_offline_private_key
similarity index 100%
rename from .jjconflict-base-0/default/master_offline_private_key
rename to default/master_offline_private_key
diff --git a/.jjconflict-base-0/dune-project b/dune-project
similarity index 100%
rename from .jjconflict-base-0/dune-project
rename to dune-project
diff --git a/.jjconflict-base-0/mte.opam b/mte.opam
similarity index 100%
rename from .jjconflict-base-0/mte.opam
rename to mte.opam
diff --git a/.jjconflict-base-0/src/amount.ml b/src/amount.ml
similarity index 100%
rename from .jjconflict-base-0/src/amount.ml
rename to src/amount.ml
diff --git a/.jjconflict-base-0/src/amount.mli b/src/amount.mli
similarity index 100%
rename from .jjconflict-base-0/src/amount.mli
rename to src/amount.mli
diff --git a/.jjconflict-base-0/src/api.ml b/src/api.ml
similarity index 100%
rename from .jjconflict-base-0/src/api.ml
rename to src/api.ml
diff --git a/.jjconflict-base-0/src/assets.ml b/src/assets.ml
similarity index 100%
rename from .jjconflict-base-0/src/assets.ml
rename to src/assets.ml
diff --git a/.jjconflict-base-0/src/b32.ml b/src/b32.ml
similarity index 100%
rename from .jjconflict-base-0/src/b32.ml
rename to src/b32.ml
diff --git a/.jjconflict-base-0/src/config.ml b/src/config.ml
similarity index 100%
rename from .jjconflict-base-0/src/config.ml
rename to src/config.ml
diff --git a/.jjconflict-base-0/src/crypto.ml b/src/crypto.ml
similarity index 100%
rename from .jjconflict-base-0/src/crypto.ml
rename to src/crypto.ml
diff --git a/.jjconflict-base-0/src/denomination.ml b/src/denomination.ml
similarity index 100%
rename from .jjconflict-base-0/src/denomination.ml
rename to src/denomination.ml
diff --git a/.jjconflict-base-0/src/devices.ml b/src/devices.ml
similarity index 100%
rename from .jjconflict-base-0/src/devices.ml
rename to src/devices.ml
diff --git a/.jjconflict-base-0/src/dune b/src/dune
similarity index 100%
rename from .jjconflict-base-0/src/dune
rename to src/dune
diff --git a/.jjconflict-base-0/src/hash.ml b/src/hash.ml
similarity index 100%
rename from .jjconflict-base-0/src/hash.ml
rename to src/hash.ml
diff --git a/.jjconflict-base-0/src/headers.ml b/src/headers.ml
similarity index 100%
rename from .jjconflict-base-0/src/headers.ml
rename to src/headers.ml
diff --git a/.jjconflict-base-0/src/headers_lib.ml b/src/headers_lib.ml
similarity index 100%
rename from .jjconflict-base-0/src/headers_lib.ml
rename to src/headers_lib.ml
diff --git a/.jjconflict-base-0/src/http_information.ml b/src/http_information.ml
similarity index 100%
rename from .jjconflict-base-0/src/http_information.ml
rename to src/http_information.ml
diff --git a/.jjconflict-side-1/src/http_management.ml b/src/http_management.ml
similarity index 100%
rename from .jjconflict-side-1/src/http_management.ml
rename to src/http_management.ml
diff --git a/.jjconflict-base-0/src/http_terms.ml b/src/http_terms.ml
similarity index 100%
rename from .jjconflict-base-0/src/http_terms.ml
rename to src/http_terms.ml
diff --git a/.jjconflict-side-1/src/keys.ml b/src/keys.ml
similarity index 97%
rename from .jjconflict-side-1/src/keys.ml
rename to src/keys.ml
index 44532ccb..dbd5255c 100644
--- a/.jjconflict-side-1/src/keys.ml
+++ b/src/keys.ml
@@ -442,18 +442,23 @@ module Make (Conn : Pg.CONN) = struct
let sk = { sk with revoked_sig= Some revoked_sig } in
Hashtbl.replace t.sk_ht pub sk;
- (* TODO revoke, apply to database *)
- Ok ()
+ let+ () =
+ Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
+ in
+ ()
- let revoke_denomination pub revoked_sig =
- match Hashtbl.find_opt t.dn_ht pub with
+ let revoke_denomination h_pub revoked_sig =
+ match Hashtbl.find_opt t.dn_ht h_pub with
| None -> Error "Keys revoke_denomination: denomination not found."
| Some dn ->
let dn = { dn with revoked_sig= Some revoked_sig } in
- Hashtbl.replace t.dn_ht pub dn;
+ Hashtbl.replace t.dn_ht h_pub dn;
- (* TODO revoke, apply to database *)
- Ok ()
+ let+ () =
+ Pg.insert_denomination_revocation conn h_pub revoked_sig
+ |> unwrap_err_caqti
+ in
+ ()
let save () =
let* () = write_eddsa sm_key_fname t.sm_key in
diff --git a/.jjconflict-base-0/src/keys.mli b/src/keys.mli
similarity index 100%
rename from .jjconflict-base-0/src/keys.mli
rename to src/keys.mli
diff --git a/.jjconflict-base-0/src/mte.ml b/src/mte.ml
similarity index 100%
rename from .jjconflict-base-0/src/mte.ml
rename to src/mte.ml
diff --git a/.jjconflict-base-0/src/parse_config.ml b/src/parse_config.ml
similarity index 100%
rename from .jjconflict-base-0/src/parse_config.ml
rename to src/parse_config.ml
diff --git a/.jjconflict-base-0/src/pg.ml b/src/pg.ml
similarity index 100%
rename from .jjconflict-base-0/src/pg.ml
rename to src/pg.ml
diff --git a/.jjconflict-base-0/src/pg_type.ml b/src/pg_type.ml
similarity index 100%
rename from .jjconflict-base-0/src/pg_type.ml
rename to src/pg_type.ml
diff --git a/.jjconflict-base-0/src/respond.ml b/src/respond.ml
similarity index 100%
rename from .jjconflict-base-0/src/respond.ml
rename to src/respond.ml
diff --git a/.jjconflict-base-0/src/signatures.ml b/src/signatures.ml
similarity index 100%
rename from .jjconflict-base-0/src/signatures.ml
rename to src/signatures.ml
diff --git a/.jjconflict-base-0/src/signkey.ml b/src/signkey.ml
similarity index 100%
rename from .jjconflict-base-0/src/signkey.ml
rename to src/signkey.ml
diff --git a/.jjconflict-base-0/src/syntax.ml b/src/syntax.ml
similarity index 100%
rename from .jjconflict-base-0/src/syntax.ml
rename to src/syntax.ml
diff --git a/.jjconflict-base-0/src/taler_signatures.ml b/src/taler_signatures.ml
similarity index 100%
rename from .jjconflict-base-0/src/taler_signatures.ml
rename to src/taler_signatures.ml
diff --git a/.jjconflict-base-0/src/time.ml b/src/time.ml
similarity index 100%
rename from .jjconflict-base-0/src/time.ml
rename to src/time.ml
diff --git a/.jjconflict-base-0/src/time.mli b/src/time.mli
similarity index 100%
rename from .jjconflict-base-0/src/time.mli
rename to src/time.mli
diff --git a/.jjconflict-base-0/src/timestamp.ml b/src/timestamp.ml
similarity index 100%
rename from .jjconflict-base-0/src/timestamp.ml
rename to src/timestamp.ml
diff --git a/.jjconflict-base-0/src/util.ml b/src/util.ml
similarity index 100%
rename from .jjconflict-base-0/src/util.ml
rename to src/util.ml
diff --git a/.jjconflict-base-0/test/auditor_public_key b/test/auditor_public_key
similarity index 100%
rename from .jjconflict-base-0/test/auditor_public_key
rename to test/auditor_public_key
diff --git a/.jjconflict-base-0/test/dune b/test/dune
similarity index 100%
rename from .jjconflict-base-0/test/dune
rename to test/dune
diff --git a/.jjconflict-base-0/test/offline_management.sh b/test/offline_management.sh
similarity index 100%
rename from .jjconflict-base-0/test/offline_management.sh
rename to test/offline_management.sh
diff --git a/.jjconflict-base-0/test/test.ml b/test/test.ml
similarity index 100%
rename from .jjconflict-base-0/test/test.ml
rename to test/test.ml
diff --git a/.jjconflict-base-0/test/test_crypto.ml b/test/test_crypto.ml
similarity index 100%
rename from .jjconflict-base-0/test/test_crypto.ml
rename to test/test_crypto.ml
diff --git a/.jjconflict-base-0/tools/dbinit.sh b/tools/dbinit.sh
similarity index 100%
rename from .jjconflict-base-0/tools/dbinit.sh
rename to tools/dbinit.sh
diff --git a/.jjconflict-base-0/tools/dune b/tools/dune
similarity index 100%
rename from .jjconflict-base-0/tools/dune
rename to tools/dune
diff --git a/.jjconflict-base-0/tools/gen_registry_files.ml b/tools/gen_registry_files.ml
similarity index 100%
rename from .jjconflict-base-0/tools/gen_registry_files.ml
rename to tools/gen_registry_files.ml
diff --git a/.jjconflict-base-0/tools/offline.ml b/tools/offline.ml
similarity index 100%
rename from .jjconflict-base-0/tools/offline.ml
rename to tools/offline.ml
diff --git a/.jjconflict-base-0/tools/offline_impl.ml b/tools/offline_impl.ml
similarity index 100%
rename from .jjconflict-base-0/tools/offline_impl.ml
rename to tools/offline_impl.ml
diff --git a/.jjconflict-base-0/tools/recfile_parser.ml b/tools/recfile_parser.ml
similarity index 100%
rename from .jjconflict-base-0/tools/recfile_parser.ml
rename to tools/recfile_parser.ml