diff --git a/.gitignore b/.jjconflict-base-0/.gitignore
similarity index 100%
rename from .gitignore
rename to .jjconflict-base-0/.gitignore
diff --git a/.ocamlformat b/.jjconflict-base-0/.ocamlformat
similarity index 100%
rename from .ocamlformat
rename to .jjconflict-base-0/.ocamlformat
diff --git a/LICENSE b/.jjconflict-base-0/LICENSE
similarity index 100%
rename from LICENSE
rename to .jjconflict-base-0/LICENSE
diff --git a/data/assets/default.config b/.jjconflict-base-0/data/assets/default.config
similarity index 100%
rename from data/assets/default.config
rename to .jjconflict-base-0/data/assets/default.config
diff --git a/data/assets/privacy/en/0.md b/.jjconflict-base-0/data/assets/privacy/en/0.md
similarity index 100%
rename from data/assets/privacy/en/0.md
rename to .jjconflict-base-0/data/assets/privacy/en/0.md
diff --git a/data/assets/privacy/en/0.txt b/.jjconflict-base-0/data/assets/privacy/en/0.txt
similarity index 100%
rename from data/assets/privacy/en/0.txt
rename to .jjconflict-base-0/data/assets/privacy/en/0.txt
diff --git a/data/assets/terms/en/0.md b/.jjconflict-base-0/data/assets/terms/en/0.md
similarity index 100%
rename from data/assets/terms/en/0.md
rename to .jjconflict-base-0/data/assets/terms/en/0.md
diff --git a/data/assets/terms/en/0.txt b/.jjconflict-base-0/data/assets/terms/en/0.txt
similarity index 100%
rename from data/assets/terms/en/0.txt
rename to .jjconflict-base-0/data/assets/terms/en/0.txt
diff --git a/data/auditor_private_key b/.jjconflict-base-0/data/auditor_private_key
similarity index 100%
rename from data/auditor_private_key
rename to .jjconflict-base-0/data/auditor_private_key
diff --git a/data/auditor_public_key b/.jjconflict-base-0/data/auditor_public_key
similarity index 100%
rename from data/auditor_public_key
rename to .jjconflict-base-0/data/auditor_public_key
diff --git a/data/master_offline_private_key b/.jjconflict-base-0/data/master_offline_private_key
similarity index 100%
rename from data/master_offline_private_key
rename to .jjconflict-base-0/data/master_offline_private_key
diff --git a/data/secmod/.gitkeep b/.jjconflict-base-0/data/secmod/.gitkeep
similarity index 100%
rename from data/secmod/.gitkeep
rename to .jjconflict-base-0/data/secmod/.gitkeep
diff --git a/dune-project b/.jjconflict-base-0/dune-project
similarity index 100%
rename from dune-project
rename to .jjconflict-base-0/dune-project
diff --git a/include/dune b/.jjconflict-base-0/include/dune
similarity index 100%
rename from include/dune
rename to .jjconflict-base-0/include/dune
diff --git a/include/taler_signatures.ml b/.jjconflict-base-0/include/taler_signatures.ml
similarity index 100%
rename from include/taler_signatures.ml
rename to .jjconflict-base-0/include/taler_signatures.ml
diff --git a/mte.opam b/.jjconflict-base-0/mte.opam
similarity index 100%
rename from mte.opam
rename to .jjconflict-base-0/mte.opam
diff --git a/src/amount.ml b/.jjconflict-base-0/src/amount.ml
similarity index 100%
rename from src/amount.ml
rename to .jjconflict-base-0/src/amount.ml
diff --git a/src/amount.mli b/.jjconflict-base-0/src/amount.mli
similarity index 100%
rename from src/amount.mli
rename to .jjconflict-base-0/src/amount.mli
diff --git a/src/api.ml b/.jjconflict-base-0/src/api.ml
similarity index 100%
rename from src/api.ml
rename to .jjconflict-base-0/src/api.ml
diff --git a/src/assets.ml b/.jjconflict-base-0/src/assets.ml
similarity index 100%
rename from src/assets.ml
rename to .jjconflict-base-0/src/assets.ml
diff --git a/src/b32.ml b/.jjconflict-base-0/src/b32.ml
similarity index 100%
rename from src/b32.ml
rename to .jjconflict-base-0/src/b32.ml
diff --git a/src/config.ml b/.jjconflict-base-0/src/config.ml
similarity index 100%
rename from src/config.ml
rename to .jjconflict-base-0/src/config.ml
diff --git a/src/crypto.ml b/.jjconflict-base-0/src/crypto.ml
similarity index 100%
rename from src/crypto.ml
rename to .jjconflict-base-0/src/crypto.ml
diff --git a/src/data_file.ml b/.jjconflict-base-0/src/data_file.ml
similarity index 100%
rename from src/data_file.ml
rename to .jjconflict-base-0/src/data_file.ml
diff --git a/src/denom_data.ml b/.jjconflict-base-0/src/denom_data.ml
similarity index 100%
rename from src/denom_data.ml
rename to .jjconflict-base-0/src/denom_data.ml
diff --git a/src/devices.ml b/.jjconflict-base-0/src/devices.ml
similarity index 100%
rename from src/devices.ml
rename to .jjconflict-base-0/src/devices.ml
diff --git a/src/dune b/.jjconflict-base-0/src/dune
similarity index 100%
rename from src/dune
rename to .jjconflict-base-0/src/dune
diff --git a/src/hash.ml b/.jjconflict-base-0/src/hash.ml
similarity index 100%
rename from src/hash.ml
rename to .jjconflict-base-0/src/hash.ml
diff --git a/src/headers.ml b/.jjconflict-base-0/src/headers.ml
similarity index 70%
rename from src/headers.ml
rename to .jjconflict-base-0/src/headers.ml
index ae740b4f..f41fc976 100644
--- a/src/headers.ml
+++ b/.jjconflict-base-0/src/headers.ml
@@ -13,15 +13,21 @@ let avail_languages_header_value =
s
let select_mimetype headers =
- let accept = Vif.Headers.get headers "accept" in
- Cohttp.Accept.media_ranges accept
+ let opt = Vif.Headers.get headers "accept" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept: %s" s);
+ Cohttp.Accept.media_ranges opt
|> Cohttp.Accept.qsort
|> List.filter_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
|> List.find_opt Assets.is_supported_mimetype
let select_language headers =
- let accept_language = Vif.Headers.get headers "accept-language" in
- Cohttp.Accept.languages accept_language
+ let opt = Vif.Headers.get headers "accept-language" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept-language: %s" s);
+ Cohttp.Accept.languages opt
|> Cohttp.Accept.qsort
|> List.map (fun (_q, lang) -> lang)
|> List.map (function
@@ -35,8 +41,11 @@ let select_language headers =
|> Option.value ~default:Assets.default_lang
let select_encoding headers =
- Vif.Headers.get headers "accept-encoding"
- |> Cohttp.Accept.encodings
+ let opt = Vif.Headers.get headers "accept-encoding" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept-encoding: %s" s);
+ Cohttp.Accept.encodings opt
|> Cohttp.Accept.qsort
|> List.map snd
|> List.filter_map (function
diff --git a/src/headers_lib.ml b/.jjconflict-base-0/src/headers_lib.ml
similarity index 100%
rename from src/headers_lib.ml
rename to .jjconflict-base-0/src/headers_lib.ml
diff --git a/src/http_keys.ml b/.jjconflict-base-0/src/http_keys.ml
similarity index 99%
rename from src/http_keys.ml
rename to .jjconflict-base-0/src/http_keys.ml
index 0fd92a81..eaea4776 100644
--- a/src/http_keys.ml
+++ b/.jjconflict-base-0/src/http_keys.ml
@@ -190,7 +190,10 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
let recoup = (* TODO /recoup *) [] in
let* global_fees =
+ (* WIP DEBUG
Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti
+ *)
+ Ok []
in
let* auditors =
(* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *)
@@ -241,7 +244,7 @@ let jsont = ExchangeKeysResponse.jsont
(* TODO query param ?last_issue_date *)
let f req server _env =
- Logs.info (fun m -> m "GET /keys/");
+ Logs.info (fun m -> m "GET /keys");
let db_conn = Vif.Server.device Devices.db_connection server in
let sm = Vif.Server.device Devices.secmod server in
let res =
diff --git a/src/http_management.ml b/.jjconflict-base-0/src/http_management.ml
similarity index 99%
rename from src/http_management.ml
rename to .jjconflict-base-0/src/http_management.ml
index 61cb5e5e..4b0aa352 100644
--- a/src/http_management.ml
+++ b/.jjconflict-base-0/src/http_management.ml
@@ -135,6 +135,7 @@ module Keys_post = struct
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
diff --git a/src/mte.ml b/.jjconflict-base-0/src/mte.ml
similarity index 100%
rename from src/mte.ml
rename to .jjconflict-base-0/src/mte.ml
diff --git a/src/parse_config.ml b/.jjconflict-base-0/src/parse_config.ml
similarity index 100%
rename from src/parse_config.ml
rename to .jjconflict-base-0/src/parse_config.ml
diff --git a/src/pg.ml b/.jjconflict-base-0/src/pg.ml
similarity index 100%
rename from src/pg.ml
rename to .jjconflict-base-0/src/pg.ml
diff --git a/src/pg_type.ml b/.jjconflict-base-0/src/pg_type.ml
similarity index 100%
rename from src/pg_type.ml
rename to .jjconflict-base-0/src/pg_type.ml
diff --git a/src/respond_util.ml b/.jjconflict-base-0/src/respond_util.ml
similarity index 100%
rename from src/respond_util.ml
rename to .jjconflict-base-0/src/respond_util.ml
diff --git a/src/secmod.ml b/.jjconflict-base-0/src/secmod.ml
similarity index 100%
rename from src/secmod.ml
rename to .jjconflict-base-0/src/secmod.ml
diff --git a/src/secmod.mli b/.jjconflict-base-0/src/secmod.mli
similarity index 100%
rename from src/secmod.mli
rename to .jjconflict-base-0/src/secmod.mli
diff --git a/src/signatures.ml b/.jjconflict-base-0/src/signatures.ml
similarity index 99%
rename from src/signatures.ml
rename to .jjconflict-base-0/src/signatures.ml
index 6a6b67ce..06f44cee 100644
--- a/src/signatures.ml
+++ b/.jjconflict-base-0/src/signatures.ml
@@ -248,6 +248,9 @@ module DenominationKeyValidity = struct
fee_withdraw: AmountNBO.t;
fee_deposit: AmountNBO.t;
fee_refresh: AmountNBO.t;
+ (* TODO debug sig
+ missing field from taler doc *)
+ fee_refund: AmountNBO.t;
denom_hash: DenominationHash.t;
}
@@ -267,6 +270,7 @@ module DenominationKeyValidity = struct
fee_withdraw
fee_deposit
fee_refresh
+ fee_refund
denom_hash
->
{
@@ -279,6 +283,7 @@ module DenominationKeyValidity = struct
fee_withdraw;
fee_deposit;
fee_refresh;
+ fee_refund;
denom_hash;
})
|+ Purpose.field purpose
@@ -291,6 +296,7 @@ module DenominationKeyValidity = struct
|+ 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
diff --git a/src/signkey_data.ml b/.jjconflict-base-0/src/signkey_data.ml
similarity index 100%
rename from src/signkey_data.ml
rename to .jjconflict-base-0/src/signkey_data.ml
diff --git a/src/static.ml b/.jjconflict-base-0/src/static.ml
similarity index 68%
rename from src/static.ml
rename to .jjconflict-base-0/src/static.ml
index 57b24dcd..52a7278d 100644
--- a/src/static.ml
+++ b/.jjconflict-base-0/src/static.ml
@@ -19,11 +19,13 @@ module Respond_with = struct
let code = -1 in
let err = ErrorDetail.make ?hint code in
let s = encode_exn ErrorDetail.jsont err in
+ Logs.err (fun m -> m "ErrorDetail: `%s`" s);
s
end
let bad_request ?hint req =
let body = error_detail ?hint `Bad_request in
+ let* () = add ~field:"content-type" "application/json" in
let* () = with_string ?compression:None req body in
respond `Bad_request
@@ -35,12 +37,13 @@ module Respond_with = struct
let body =
error_detail ~hint:"no acceptable mimetype" `Unsupported_media_type
in
- let* () = with_string ?compression:None req body in
+ let* () = add ~field:"content-type" "application/json" in
let* () = add ~field:"accept" Headers.accept_header_value in
+ let* () = with_string ?compression:None req body in
respond `Unsupported_media_type
end
-let aux kind req _server _env =
+let _aux kind req _server _env =
let etag = Assets.etag kind in
let headers = Vif.Request.headers req in
let has_matching_etag =
@@ -50,11 +53,17 @@ let aux kind req _server _env =
Headers_lib.Etag.parse s |> Result.map (Headers_lib.Etag.evaluate etag)
in
match has_matching_etag with
- | Error e -> Respond_with.bad_request ~hint:e req
- | Ok true -> Respond_with.not_modified ()
+ | Error e ->
+ Logs.err (fun m -> m "bad request");
+ Respond_with.bad_request ~hint:e req
+ | Ok true ->
+ Logs.err (fun m -> m "not modified");
+ Respond_with.not_modified ()
| Ok false -> (
match Headers.select_mimetype headers with
- | None -> Respond_with.unsupported_media_type req
+ | None ->
+ Logs.err (fun m -> m "unsupported_media_type");
+ Respond_with.unsupported_media_type req
| Some mime ->
let lang = Headers.select_language headers in
let compression = Headers.select_encoding headers in
@@ -80,5 +89,27 @@ let aux kind req _server _env =
in
respond `OK)
-let terms req _server _env = aux Assets.Terms req _server _env
-let privacy req _server _env = aux Assets.Privacy req _server _env
+(* WIP DEBUG *)
+let aux _kind req _server _env =
+ let open Vif.Response in
+ let open Syntax in
+ let data = "uhuh" in
+ let etag = "0" in
+ let content_type = "text/plain" in
+ let* () = with_string req data in
+ let* () = add ~field:"etag" etag in
+ let* () =
+ (* todo: is it "taler-privacy-version" for /policy ? *)
+ add ~field:"taler-terms-version" Assets.terms_legal_version
+ in
+ let* () = add ~field:"avail-languages" Headers.avail_languages_header_value in
+ let* () = add ~field:"content-type" content_type 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/src/syntax.ml b/.jjconflict-base-0/src/syntax.ml
similarity index 100%
rename from src/syntax.ml
rename to .jjconflict-base-0/src/syntax.ml
diff --git a/src/time.ml b/.jjconflict-base-0/src/time.ml
similarity index 100%
rename from src/time.ml
rename to .jjconflict-base-0/src/time.ml
diff --git a/src/time.mli b/.jjconflict-base-0/src/time.mli
similarity index 100%
rename from src/time.mli
rename to .jjconflict-base-0/src/time.mli
diff --git a/src/timestamp.ml b/.jjconflict-base-0/src/timestamp.ml
similarity index 100%
rename from src/timestamp.ml
rename to .jjconflict-base-0/src/timestamp.ml
diff --git a/src/util.ml b/.jjconflict-base-0/src/util.ml
similarity index 100%
rename from src/util.ml
rename to .jjconflict-base-0/src/util.ml
diff --git a/test/dune b/.jjconflict-base-0/test/dune
similarity index 100%
rename from test/dune
rename to .jjconflict-base-0/test/dune
diff --git a/test/offline_management.sh b/.jjconflict-base-0/test/offline_management.sh
similarity index 100%
rename from test/offline_management.sh
rename to .jjconflict-base-0/test/offline_management.sh
diff --git a/test/signatures.c b/.jjconflict-base-0/test/signatures.c
similarity index 100%
rename from test/signatures.c
rename to .jjconflict-base-0/test/signatures.c
diff --git a/.jjconflict-base-0/test/test.ml b/.jjconflict-base-0/test/test.ml
new file mode 100644
index 00000000..03831efc
--- /dev/null
+++ b/.jjconflict-base-0/test/test.ml
@@ -0,0 +1,110 @@
+let () = Mirage_crypto_rng_unix.use_default ()
+let get_ok = function Error e -> failwith e | Ok v -> v
+
+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 |> get_ok in
+ assert (to_octets priv = to_octets priv')
+ in
+ let () =
+ let open Crypto.RsaPublicKey in
+ let pub' = pub |> to_octets |> of_octets |> 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 |> get_ok in
+ let decode v = decode jsont v |> 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.Etag in
+ let check input = assert (Result.is_ok (parse input)) in
+ let check_bad input = assert (Result.is_error (parse input)) in
+
+ check "*";
+ check "\"foo\"";
+ check "W/\"foo\"";
+ check "\"foo\", \"bar\"";
+ check " W/\"x\" , W/\"y\" , \"z\" ";
+ check " \"one\" , \"two\" , \"three\" ";
+ check "W/\"a\"";
+ check " W/\"a\" , \"b\"";
+
+ check_bad "";
+ check_bad "foo";
+ check_bad "W/foo";
+ check_bad "W/\"unterminated";
+ check_bad "\"foo\", W/";
+ check_bad "* , \"bar\"";
+ check_bad "\"a\" \"b\"";
+ check_bad "W/\"a\" W/\"b\"";
+ check_bad "\"fo\x7Fo\"";
+
+ (* TODO trailing comma are valid actually, I think *)
+ check_bad "\"foo\" ,";
+ check_bad ", \"foo\"";
+ ()
+
+(*
+
+let () =
+ let open Binary_formats.WithdrawConfirmationPS in
+ let str64 = String.init 64 (fun i -> Char.unsafe_chr (i + 1)) in
+ let dummy_t = { h_planchets= { hash= str64 }; noreveal_index= 0_l } in
+ let size = Bin.size_of_value bin dummy_t |> Option.get in
+ assert (size = 76);
+
+ (* for cmp test with signatures.c output *)
+ (*
+ let raw_str = Bin.to_string bin dummy_t in
+ Printf.printf "%s" raw_str;
+ *)
+ ()
+
+ *)
diff --git a/tools/dune b/.jjconflict-base-0/tools/dune
similarity index 100%
rename from tools/dune
rename to .jjconflict-base-0/tools/dune
diff --git a/tools/offline.ml b/.jjconflict-base-0/tools/offline.ml
similarity index 100%
rename from tools/offline.ml
rename to .jjconflict-base-0/tools/offline.ml
diff --git a/tools/offline_impl.ml b/.jjconflict-base-0/tools/offline_impl.ml
similarity index 100%
rename from tools/offline_impl.ml
rename to .jjconflict-base-0/tools/offline_impl.ml
diff --git a/tools/offline_sig.ml b/.jjconflict-base-0/tools/offline_sig.ml
similarity index 98%
rename from tools/offline_sig.ml
rename to .jjconflict-base-0/tools/offline_sig.ml
index 94675300..f89cca19 100644
--- a/tools/offline_sig.ml
+++ b/.jjconflict-base-0/tools/offline_sig.ml
@@ -87,7 +87,7 @@ let mk_future_keys =
fee_withdraw;
fee_deposit;
fee_refresh;
- fee_refund= _;
+ fee_refund;
denom_secmod_sig= _;
} =
let octets = DenominationKey.to_octets denom_pub in
@@ -107,6 +107,7 @@ let mk_future_keys =
fee_withdraw;
fee_deposit;
fee_refresh;
+ fee_refund;
denom_hash= h_denom_pub;
}
in
diff --git a/.jjconflict-side-0/.gitignore b/.jjconflict-side-0/.gitignore
new file mode 100644
index 00000000..dbd4866f
--- /dev/null
+++ b/.jjconflict-side-0/.gitignore
@@ -0,0 +1,3 @@
+_build
+data/secmod/*
+!data/secmod/.gitkeep
diff --git a/.jjconflict-side-0/.ocamlformat b/.jjconflict-side-0/.ocamlformat
new file mode 100644
index 00000000..43b12fc0
--- /dev/null
+++ b/.jjconflict-side-0/.ocamlformat
@@ -0,0 +1,15 @@
+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
new file mode 100644
index 00000000..be3f7b28
--- /dev/null
+++ b/.jjconflict-side-0/LICENSE
@@ -0,0 +1,661 @@
+ 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/data/assets/default.config b/.jjconflict-side-0/data/assets/default.config
new file mode 100644
index 00000000..a6c89c52
--- /dev/null
+++ b/.jjconflict-side-0/data/assets/default.config
@@ -0,0 +1,74 @@
+[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/data/assets/privacy/en/0.md b/.jjconflict-side-0/data/assets/privacy/en/0.md
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-0/data/assets/privacy/en/0.md
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-0/data/assets/privacy/en/0.txt b/.jjconflict-side-0/data/assets/privacy/en/0.txt
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-0/data/assets/privacy/en/0.txt
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-0/data/assets/terms/en/0.md b/.jjconflict-side-0/data/assets/terms/en/0.md
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-0/data/assets/terms/en/0.md
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-0/data/assets/terms/en/0.txt b/.jjconflict-side-0/data/assets/terms/en/0.txt
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-0/data/assets/terms/en/0.txt
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-0/data/auditor_private_key b/.jjconflict-side-0/data/auditor_private_key
new file mode 100644
index 00000000..82aad694
--- /dev/null
+++ b/.jjconflict-side-0/data/auditor_private_key
@@ -0,0 +1 @@
+Iî÷q¸àwÇ´Y—›gbÙ'R+5µ™â°ƒˆyë>
\ No newline at end of file
diff --git a/.jjconflict-side-0/data/auditor_public_key b/.jjconflict-side-0/data/auditor_public_key
new file mode 100644
index 00000000..4b97fccf
--- /dev/null
+++ b/.jjconflict-side-0/data/auditor_public_key
@@ -0,0 +1 @@
+A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0
diff --git a/.jjconflict-side-0/data/master_offline_private_key b/.jjconflict-side-0/data/master_offline_private_key
new file mode 100644
index 00000000..739df007
Binary files /dev/null and b/.jjconflict-side-0/data/master_offline_private_key differ
diff --git a/.jjconflict-side-0/data/secmod/.gitkeep b/.jjconflict-side-0/data/secmod/.gitkeep
new file mode 100644
index 00000000..e69de29b
diff --git a/.jjconflict-side-0/dune-project b/.jjconflict-side-0/dune-project
new file mode 100644
index 00000000..5bd4e1f1
--- /dev/null
+++ b/.jjconflict-side-0/dune-project
@@ -0,0 +1,46 @@
+(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
+ zarith
+ mirage-crypto
+ digestif
+ duration
+ jsont
+ cohttp
+ ptime
+ logs
+ (ocamlformat :with-dev-setup)
+ ))
diff --git a/.jjconflict-side-0/include/dune b/.jjconflict-side-0/include/dune
new file mode 100644
index 00000000..3418869c
--- /dev/null
+++ b/.jjconflict-side-0/include/dune
@@ -0,0 +1,5 @@
+(library
+ (name include)
+ ; (wrapped false)
+ (modules taler_signatures)
+ (libraries))
diff --git a/.jjconflict-side-0/include/taler_signatures.ml b/.jjconflict-side-0/include/taler_signatures.ml
new file mode 100644
index 00000000..d9211977
--- /dev/null
+++ b/.jjconflict-side-0/include/taler_signatures.ml
@@ -0,0 +1,78 @@
+(* This file was generated by using data and/or code from the GNU Taler project,
+ under the AGPL-v3 licence.
+ Do not edit it. *)
+
+let master_aml_key : int32 = 1017_l
+let master_drain_profit : int32 = 1018_l
+let master_partner_details : int32 = 1019_l
+let master_signing_key_revoked : int32 = 1020_l
+let master_add_wire : int32 = 1021_l
+let master_global_fees : int32 = 1022_l
+let master_del_wire : int32 = 1023_l
+let master_signing_key_validity : int32 = 1024_l
+let master_denomination_key_validity : int32 = 1025_l
+let master_add_auditor : int32 = 1026_l
+let master_del_auditor : int32 = 1027_l
+let master_wire_fees : int32 = 1028_l
+let master_denomination_key_revoked : int32 = 1029_l
+let master_wire_details : int32 = 1030_l
+let master_extension : int32 = 1031_l
+let exchange_reserve_status : int32 = 1032_l
+let exchange_confirm_deposit : int32 = 1033_l
+let exchange_confirm_melt : int32 = 1034_l
+let exchange_key_set : int32 = 1035_l
+let exchange_confirm_wire : int32 = 1036_l
+let exchange_confirm_wire_deposit : int32 = 1037_l
+let exchange_confirm_refund : int32 = 1038_l
+let exchange_confirm_recoup : int32 = 1039_l
+let exchange_reserve_closed : int32 = 1040_l
+let exchange_confirm_recoup_refresh : int32 = 1041_l
+let exchange_affirm_denom_unknown : int32 = 1042_l
+let exchange_affirm_denom_expired : int32 = 1043_l
+let exchange_confirm_purse_creation : int32 = 1045_l
+let exchange_confirm_purse_merged : int32 = 1046_l
+let exchange_purse_status : int32 = 1047_l
+let exchange_reserve_attest_details : int32 = 1048_l
+let exchange_confirm_purse_refund : int32 = 1049_l
+let exchange_confirm_withdraw : int32 = 1050_l
+let auditor_exchange_keys : int32 = 1064_l
+let merchant_contract : int32 = 1101_l
+let merchant_refund : int32 = 1102_l
+let merchant_track_transaction : int32 = 1103_l
+let merchant_payment_ok : int32 = 1104_l
+let merchant_wire_details : int32 = 1107_l
+let merchant_token_issue : int32 = 1108_l
+let wallet_reserve_withdraw : int32 = 1200_l
+let wallet_coin_deposit : int32 = 1201_l
+let wallet_coin_melt : int32 = 1202_l
+let wallet_coin_recoup : int32 = 1203_l
+let wallet_coin_link : int32 = 1204_l
+let wallet_account_setup : int32 = 1205_l
+let wallet_coin_recoup_refresh : int32 = 1206_l
+let wallet_age_attestation : int32 = 1207_l
+let wallet_reserve_history : int32 = 1208_l
+let wallet_coin_history : int32 = 1209_l
+let wallet_purse_create : int32 = 1210_l
+let wallet_purse_deposit : int32 = 1211_l
+let wallet_purse_status : int32 = 1212_l
+let wallet_purse_merge : int32 = 1213_l
+let wallet_account_merge : int32 = 1214_l
+let wallet_reserve_close : int32 = 1215_l
+let wallet_purse_econtract : int32 = 1216_l
+let wallet_reserve_open : int32 = 1217_l
+let wallet_reserve_open_deposit : int32 = 1218_l
+let wallet_reserve_attest_details : int32 = 1219_l
+let wallet_purse_delete : int32 = 1220_l
+let wallet_reserve_age_withdraw : int32 = 1221_l
+let wallet_token_use : int32 = 1222_l
+let mailbox_messages_delete : int32 = 1223_l
+let sm_rsa_denomination_key : int32 = 1250_l
+let sm_signing_key : int32 = 1251_l
+let sm_cs_denomination_key : int32 = 1252_l
+let client_test_eddsa : int32 = 1302_l
+let exchange_test_eddsa : int32 = 1303_l
+let aml_decision : int32 = 1350_l
+let aml_query : int32 = 1351_l
+let kyc_auth : int32 = 1360_l
+let anastasis_policy_upload : int32 = 1400_l
+let sync_backup_upload : int32 = 1450_l
diff --git a/.jjconflict-side-0/mte.opam b/.jjconflict-side-0/mte.opam
new file mode 100644
index 00000000..8bdbc121
--- /dev/null
+++ b/.jjconflict-side-0/mte.opam
@@ -0,0 +1,49 @@
+# 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"
+ "zarith"
+ "mirage-crypto"
+ "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
new file mode 100644
index 00000000..65fde44d
--- /dev/null
+++ b/.jjconflict-side-0/src/amount.ml
@@ -0,0 +1,121 @@
+(* TODO
+ have safe amount arithmetic
+ make type private
+ redefine an Amount module with currency enforced to be Config.currency? *)
+(* Amounts of currency, serialized as `:.`
+ Fixed-precision numbers with 8 decimal places.
+ - must be at most 11 characters long
+ only consist of ASCII letters (a-zA-Z).
+ - integer part of may be at most 2^52.
+ - fractional part of may contain at most 8 decimal digits.
+
+ Prefixed with '+' or '-' in certain contexts.
+ When no sign is present, the amount is assumed to be positive. *)
+type sign =
+ | Sign_plus
+ | Sign_minus
+
+type t = {
+ sign: sign option;
+ currency: string;
+ value: Int64.t;
+ fraction: Int32.t;
+}
+
+let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
+let check_not msg = function false -> Ok () | true -> Error msg
+let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64
+let fraction_upper_bound = Int32.of_int 100_000_000
+
+let make ~sign ~currency ~value ~fraction =
+ let* () = check_not "value is negative" (value < Int64.zero) in
+ let* () = check_not "fraction is negative" (fraction < Int32.zero) in
+ let* () =
+ check_not "value is greater than 2^52" (value > value_upper_bound)
+ in
+ let* () =
+ check_not "fraction has more than 8 decimal digits"
+ (fraction >= fraction_upper_bound)
+ in
+ Ok { sign; currency; value; fraction }
+
+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 } ->
+ pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction
+
+let to_string = Fmt.str "%a" pp
+
+let of_string =
+ let open Angstrom in
+ let parse_sign =
+ choice
+ [
+ char '+' *> return (Some Sign_plus);
+ char '-' *> return (Some Sign_minus);
+ return None;
+ ]
+ in
+ let parse_currency =
+ (* TODO currency string constraint/format *)
+ take_while1 (function
+ | 'a' .. 'z' | 'A' .. 'Z' -> true
+ | _ -> false)
+ in
+ let parse_int64 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int64.of_string_opt
+ >>= function
+ | None -> fail "invalid integer"
+ | Some n -> return n
+ in
+ let parse_int32 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int32.of_string_opt
+ >>= function
+ | None -> fail "invalid integer"
+ | Some n -> return n
+ in
+ let parse_t =
+ lift4
+ (fun sign currency value fraction ->
+ make ~sign ~currency ~value ~fraction)
+ parse_sign parse_currency
+ (char ':' *> parse_int64)
+ (char '.' *> parse_int32)
+ in
+ fun s -> parse_string ~consume:Consume.All parse_t s |> Result.join
+
+let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
+let currency_len = 12
+
+let pad_currency s =
+ let len = String.length s in
+ assert (len <= 11);
+ let b = Bytes.make 12 '\x00' in
+ Bytes.blit_string s 0 b 0 len;
+ Bytes.to_string b
+
+let bin =
+ let open Bin in
+ record (fun _value _fraction _currency ->
+ (* no need to decode amount? *)
+ assert false)
+ |+ field neint64 (fun t -> t.value)
+ |+ field neint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency t.currency)
+ |> sealr
+
+let bin_nbo =
+ let open Bin in
+ record (fun _value _fraction _currency -> assert false)
+ |+ field beint64 (fun t -> t.value)
+ |+ field beint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency t.currency)
+ |> sealr
+
+let dummy_value = "DUMMY:0.0" |> of_string |> Result.get_ok
diff --git a/.jjconflict-side-0/src/amount.mli b/.jjconflict-side-0/src/amount.mli
new file mode 100644
index 00000000..920bed18
--- /dev/null
+++ b/.jjconflict-side-0/src/amount.mli
@@ -0,0 +1,34 @@
+(* TODO
+ ? have a currency agnostic amount_lib.ml and specialize amount.ml to Config.currency *)
+
+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 currency_len : int
+val jsont : t Jsont.t
+
+(* only for encoding *)
+val bin : t Bin.t
+val bin_nbo : t Bin.t
+
+(* TODO
+ dummy value to use as placeholder for WIP *)
+val dummy_value : t
diff --git a/.jjconflict-side-0/src/api.ml b/.jjconflict-side-0/src/api.ml
new file mode 100644
index 00000000..519cfb38
--- /dev/null
+++ b/.jjconflict-side-0/src/api.ml
@@ -0,0 +1,1347 @@
+(* TODO
+ ppx?
+ normalized JSON-object
+ for signature of ExchangeKeysResponse.exetensions field
+ option: correct use opt_mem or Jsont.option
+ better types:
+ - payto_uri
+ - uri *)
+
+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: const string
+ name: "taler-exchange";*)
+ implementation: string option;
+ currency: string;
+ shopping_url: string option;
+ open_banking_gateway: string option;
+ currency_specification: CurrencySpecification.t;
+ supported_kyc_requirements: string list;
+ aml_spa_dialect: string option;
+ }
+
+ let jsont =
+ let make version implementation currency shopping_url open_banking_gateway
+ currency_specification supported_kyc_requirements aml_spa_dialect =
+ {
+ version;
+ implementation;
+ currency;
+ shopping_url;
+ open_banking_gateway;
+ currency_specification;
+ supported_kyc_requirements;
+ aml_spa_dialect;
+ }
+ in
+ let version v = v.version 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 supported_kyc_requirements v = v.supported_kyc_requirements in
+ let aml_spa_dialect v = v.aml_spa_dialect in
+ map ~kind:"ExchangeVersionResponse" make
+ |> mem "version" Jsont.string ~enc:version
+ |> 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 "supported_kyc_requirements" (Jsont.list Jsont.string)
+ ~enc:supported_kyc_requirements
+ |> mem "aml_spa_dialect" (Jsont.option Jsont.string) ~enc:aml_spa_dialect
+ |> finish
+end
+
+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;
+ (* TODO monotonic time
+ something about using monotonic system time here! *)
+ 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;
+ (* TODO monotonic time *)
+ 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;
+ (* TODO monotonic time *)
+ 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;
+ (* TODO monotonic time *)
+ 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;
+ }
+
+ 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
new file mode 100644
index 00000000..9d6c8088
--- /dev/null
+++ b/.jjconflict-side-0/src/assets.ml
@@ -0,0 +1,150 @@
+(* TODO clean up *)
+
+(* docs: https://docs.taler.net/manpages/taler-exchange.conf.5.html
+ https://docs.taler.net/design-documents/003-tos-rendering.html *)
+
+(* hardcoded config just for static assets *)
+let default_lang = "en"
+let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
+
+(* todo: Taler documentation markdown mimetype should be the prefered one, and be
+ supported, according to DD we take text/plain as default instead for now *)
+let default_mimetype = ("text", "plain")
+let default_extension = ".txt"
+let terms_legal_version = "1"
+let privacy_legal_version = "1"
+
+module Mimetype = struct
+ let mimetype_extension_assoc =
+ [
+ (("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 mimetype_l, _ = List.split mimetype_extension_assoc
+
+ let of_cohttp_media = function
+ | Cohttp.Accept.MediaType (m, m_sub) ->
+ List.find_opt (( = ) (m, m_sub)) mimetype_l
+ | AnyMediaSubtype m ->
+ List.find_opt (fun (m', _) -> String.equal m m') mimetype_l
+ | AnyMedia -> Some default_mimetype
+
+ let to_extension (m, m_sub) =
+ assert (m <> "*");
+ assert (m_sub <> "*");
+ List.assoc_opt (m, m_sub) mimetype_extension_assoc
+
+ let of_extension ext =
+ List.find_map
+ (fun (mime, ext') ->
+ match String.equal ext ext' with false -> None | true -> Some mime)
+ mimetype_extension_assoc
+
+ let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
+end
+
+(* TODO config *)
+type t =
+ | Terms
+ | Privacy
+
+let etag k =
+ Result.get_ok
+ @@ Headers_lib.Etag.of_crockford32
+ @@ match k with Terms -> "0" | Privacy -> "0"
+
+let legal_version = function
+ | Terms -> terms_legal_version
+ | Privacy -> privacy_legal_version
+
+let base_dir = function
+ | Terms -> Fpath.v "terms"
+ | Privacy -> Fpath.v "privacy"
+
+(* does some checks on assets/ folder content and infer the set of supported languages and mimetype *)
+let supported_lang_arr, supported_ext_arr =
+ let open Syntax in
+ let path_l =
+ Assets_crunch.file_list |> list_map Fpath.of_string |> function
+ | Error (`Msg e) -> Fmt.failwith "%s" e
+ | Ok x -> x
+ in
+ let aux t =
+ let prefix = base_dir t in
+ let path_l = path_l |> List.filter_map (Fpath.rem_prefix prefix) in
+ let ext_l =
+ path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
+ in
+ let lang_l =
+ path_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 path))
+ |> List.sort_uniq String.compare
+ in
+ let () =
+ 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 default_lang lang_l then
+ Fmt.failwith "default language `%s` files not found" 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"
+ in
+ (lang_l, ext_l)
+ in
+ let lang_l, ext_l = aux Terms in
+ let lang_l', ext_l' = aux Privacy in
+ let () =
+ if
+ not
+ @@ (List.equal String.equal lang_l lang_l'
+ && List.equal String.equal ext_l ext_l')
+ then
+ Fmt.failwith
+ "invalid folder structure, /terms and /privacy must support the same \
+ set of languages and mimetypes";
+ ()
+ in
+ (Array.of_list lang_l, Array.of_list ext_l)
+
+let supported_mimetype_arr =
+ Array.map Mimetype.of_extension supported_ext_arr |> Array.map Option.get
+
+let is_supported_lang lang = Array.mem lang supported_lang_arr
+let is_supported_ext ext = Array.mem ext supported_ext_arr
+let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr
+
+(* ! lang and mime must be supported *)
+let get_content ~lang ~mime t =
+ let etag = Headers_lib.Etag.to_raw_string (etag t) in
+ let ext =
+ match Mimetype.to_extension mime with
+ | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime)
+ | Some ext -> ext
+ in
+ let path = Fpath.to_string Fpath.((base_dir t / lang / etag) + 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
new file mode 100644
index 00000000..6bd06400
--- /dev/null
+++ b/.jjconflict-side-0/src/b32.ml
@@ -0,0 +1,38 @@
+(* 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
new file mode 100644
index 00000000..9be285c0
--- /dev/null
+++ b/.jjconflict-side-0/src/config.ml
@@ -0,0 +1,200 @@
+open Parse_config
+
+let config_data =
+ let path = Fpath.to_string (Fpath.v "default.config") in
+ match Assets_crunch.read path with
+ | None -> fail "static file not found: `%s`" path
+ | Some data ->
+ let v = Parse_data.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"
+ let privacy_etag = get "privacy_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_res;
+ }
+
+ 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
new file mode 100644
index 00000000..bf437fce
--- /dev/null
+++ b/.jjconflict-side-0/src/crypto.ml
@@ -0,0 +1,300 @@
+open Syntax
+
+module Binary_format_rsa = struct
+ (* TODO tests:
+ - need to strip leading zeros?
+ - endianess ok? *)
+ (* 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 rev_string len s = String.init len (fun i -> s.[len - 1 - i])
+
+ (* we reverse bytes because Z.of_bits reads bytes in little endian *)
+ let z_of_bits_be src pos len =
+ String.sub src pos len |> rev_string len |> Z.of_bits
+
+ let z_to_bits_be z =
+ let bits = Z.to_bits z in
+ rev_string (String.length bits) bits
+
+ let z_array_to_octets (arr : Z.t array) =
+ let nb = Array.length arr in
+ let bits_arr = Array.map z_to_bits_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 check = function
+ | false -> Error "rsa of_octets error, invalid data"
+ | true -> Ok ()
+
+ let z_array_of_octets ~nb s =
+ let s_len = String.length s in
+ let* () = check (s_len > 2 * nb) in
+ 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* () =
+ let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
+ check (s_len = len)
+ in
+ let z_arr =
+ Array.init nb (fun i ->
+ let len = len_arr.(i) in
+ let z = z_of_bits_be s !pos len 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
+
+ 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
+
+(* TODO key format
+ - check what is the exact format in GNUNET
+ - endianess issue? *)
+module EddsaPublicKey = 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 = 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
+ (* TODO key format
+ endianess issue? *)
+ (* 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 "signature verification failure: invalid signature"
+ | true -> Ok ()
+
+ let to_octets t = t
+
+ let of_octets v =
+ match String.length v = 64 with
+ | false ->
+ Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
+ | true -> Ok 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 check_size t =
+ match String.length t = 64 with
+ | false -> Error "EddsaSignature: invalid string length"
+ | true -> Ok ()
+
+ let jsont =
+ let of_b32 s =
+ let* t = B32.decode s in
+ let+ () = check_size t in
+ 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 sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t
+ val jsont : t Jsont.t
+end = struct
+ type t = string
+
+ (* TODO rsa sign *)
+ let sign ~key s =
+ Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s
+
+ 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 denomination_hash = Hash.DenominationHash.t
diff --git a/.jjconflict-side-0/src/data_file.ml b/.jjconflict-side-0/src/data_file.ml
new file mode 100644
index 00000000..9fa34674
--- /dev/null
+++ b/.jjconflict-side-0/src/data_file.ml
@@ -0,0 +1,35 @@
+open Bos.OS
+open Syntax
+open Crypto
+
+let read fname =
+ let* b = File.exists fname |> Syntax.unwrap_err_msg in
+ match b with
+ | false -> Ok None
+ | true ->
+ let+ content = File.read fname |> Syntax.unwrap_err_msg in
+ Some content
+
+let write_eddsa fname priv =
+ EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let write_rsa fname priv =
+ RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let read_eddsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ EddsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
+
+let read_rsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ RsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
diff --git a/.jjconflict-side-0/src/denom_data.ml b/.jjconflict-side-0/src/denom_data.ml
new file mode 100644
index 00000000..7d94367d
--- /dev/null
+++ b/.jjconflict-side-0/src/denom_data.ml
@@ -0,0 +1,18 @@
+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: denomination_hash;
+ master_sig: Signatures.DenominationKeyValidity.t option;
+ revoked_sig: Signatures.MasterDenominationKeyRevocation.t option;
+}
diff --git a/.jjconflict-side-0/src/devices.ml b/.jjconflict-side-0/src/devices.ml
new file mode 100644
index 00000000..7da26428
--- /dev/null
+++ b/.jjconflict-side-0/src/devices.ml
@@ -0,0 +1,26 @@
+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 secmod =
+ let finally _key = () in
+ Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
+ @@ fun (module Conn : Pg.CONN) (_env : env) ->
+ let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in
+ sm
diff --git a/.jjconflict-side-0/src/dune b/.jjconflict-side-0/src/dune
new file mode 100644
index 00000000..2a1a266a
--- /dev/null
+++ b/.jjconflict-side-0/src/dune
@@ -0,0 +1,45 @@
+(executable
+ (public_name mte)
+ (name mte)
+ (modules mte)
+ (libraries mte))
+
+(library
+ (name mte)
+ (wrapped false)
+ (modules :standard \ mte b32)
+ (libraries
+ b32
+ include
+ ;
+ caqti
+ caqti-miou
+ caqti-miou.unix
+ caqti-driver-pgx
+ bin
+ mirage-crypto
+ 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 ../data/assets/))
+ (action
+ (with-stdout-to
+ %{null}
+ (run ocaml-crunch -m plain ../data/assets -o %{target}))))
diff --git a/.jjconflict-side-0/src/hash.ml b/.jjconflict-side-0/src/hash.ml
new file mode 100644
index 00000000..ca32519f
--- /dev/null
+++ b/.jjconflict-side-0/src/hash.ml
@@ -0,0 +1,108 @@
+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 String.length s = 32 with
+ | false -> Fmt.failwith "Hash.of_octets failure: data is not 32 bytes"
+ | true -> SHA256.of_raw_string s
+
+ 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 String.length s = 64 with
+ | false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes"
+ | true -> SHA512.of_raw_string s
+
+ let to_octets v =
+ let s = SHA512.to_raw_string v in
+ match String.length s = 64 with
+ | false -> Fmt.failwith "Hash.to_octets failure: data is not 64 bytes"
+ | true -> s
+
+ 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
new file mode 100644
index 00000000..f41fc976
--- /dev/null
+++ b/.jjconflict-side-0/src/headers.ml
@@ -0,0 +1,61 @@
+let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item
+
+let accept_header_value =
+ let s =
+ Fmt.str "%a"
+ (pp_array Assets.Mimetype.pp_mime)
+ Assets.supported_mimetype_arr
+ in
+ s
+
+let avail_languages_header_value =
+ let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
+ s
+
+let select_mimetype headers =
+ let opt = Vif.Headers.get headers "accept" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept: %s" s);
+ Cohttp.Accept.media_ranges opt
+ |> Cohttp.Accept.qsort
+ |> List.filter_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
+ |> List.find_opt Assets.is_supported_mimetype
+
+let select_language headers =
+ let opt = Vif.Headers.get headers "accept-language" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept-language: %s" s);
+ Cohttp.Accept.languages opt
+ |> Cohttp.Accept.qsort
+ |> List.map (fun (_q, lang) -> lang)
+ |> List.map (function
+ | Cohttp.Accept.AnyLanguage -> Assets.default_lang
+ | Language language_range -> (
+ (* ignore language subtags (e.g. "en-US" -> "en") *)
+ match language_range with
+ | [] -> assert false
+ | primary_tag :: _ -> primary_tag))
+ |> List.find_opt Assets.is_supported_lang
+ |> Option.value ~default:Assets.default_lang
+
+let select_encoding headers =
+ let opt = Vif.Headers.get headers "accept-encoding" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept-encoding: %s" s);
+ Cohttp.Accept.encodings opt
+ |> Cohttp.Accept.qsort
+ |> List.map snd
+ |> List.filter_map (function
+ | Cohttp.Accept.Identity -> Some `Identity
+ | Deflate -> Some `DEFLATE
+ | Gzip -> Some `Gzip
+ | AnyEncoding -> Some Assets.default_encoding
+ | Encoding _ | Compress -> (* unsupported *) None)
+ |> function
+ | [] -> assert false
+ | `Identity :: _ -> None
+ | `DEFLATE :: _ -> Some `DEFLATE
+ | `Gzip :: _ -> Some `Gzip
diff --git a/.jjconflict-side-0/src/headers_lib.ml b/.jjconflict-side-0/src/headers_lib.ml
new file mode 100644
index 00000000..b26f5da1
--- /dev/null
+++ b/.jjconflict-side-0/src/headers_lib.ml
@@ -0,0 +1,86 @@
+(* independent library for headers fields value *)
+
+(* TODO - test - can still bypass this module and directly set Etag header, but
+ its fine *)
+module Etag : sig
+ (* module to parse etags header fields used by If-Match and If-None-Match
+ headers
+
+ https://httpwg.org/specs/rfc9110.html#field.etag *)
+ type t
+ type header_value
+
+ val parse : string -> (header_value, string) result
+ val of_crockford32 : string -> (t, string) result
+ val to_raw_string : t -> string
+ val to_field_value : t -> string
+ val evaluate : t -> header_value -> bool
+end = struct
+ (* raw etag *)
+ type t = string
+
+ (* type for the value of header field *)
+ type header_etag_item = {
+ weak: bool;
+ value: string;
+ }
+
+ type header_value =
+ | Any_etag
+ | Etag_list of header_etag_item list
+
+ let pp_header_etag_item ppf { weak; value } =
+ if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value
+
+ let to_raw_string t = t
+
+ let to_field_value t =
+ (* always weak comparison for If-None-Match header *)
+ let v = { weak= true; value= t } in
+ Fmt.str "%a" pp_header_etag_item v
+
+ let is_valid_char c =
+ let n = Char.code c in
+ (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+
+ let has_valid_charset s = String.for_all is_valid_char s
+
+ let of_crockford32 s =
+ match has_valid_charset s with
+ | false -> Error "invalid etag"
+ | true -> Ok s
+
+ let parse =
+ let open Angstrom in
+ let ws = skip_while (function ' ' -> true | _ -> false) in
+ let quoted_string =
+ char '"' *> take_till (fun c -> c = '"') <* char '"' >>= fun s ->
+ if String.for_all is_valid_char s then return s
+ else fail "found illegal char"
+ in
+ let item =
+ ws
+ *> lift2
+ (fun weak value -> { weak; value })
+ (option false (string "W/" *> return true))
+ quoted_string
+ <* ws
+ in
+ let comma = ws *> char ',' *> ws in
+ let list_of_items = sep_by1 comma item in
+ let parse_header_value =
+ char '*' *> return Any_etag
+ <|> (list_of_items >>| fun items -> Etag_list items)
+ <* end_of_input
+ in
+ fun s ->
+ match parse_string ~consume:Consume.All parse_header_value s with
+ | Error e -> Fmt.error "invalid etag: %s" e
+ | Ok v -> Ok v
+
+ let evaluate t header_value =
+ match header_value with
+ | Any_etag -> false
+ | Etag_list l ->
+ not @@ List.exists (fun { weak= _; value } -> String.equal t value) l
+end
diff --git a/.jjconflict-side-0/src/http_keys.ml b/.jjconflict-side-0/src/http_keys.ml
new file mode 100644
index 00000000..eaea4776
--- /dev/null
+++ b/.jjconflict-side-0/src/http_keys.ml
@@ -0,0 +1,265 @@
+open Syntax
+open Api
+module String_map = Stdlib.Map.Make (Stdlib.String)
+
+(* TODO
+ for now we only have one item in each "denom group"
+ change this once we have denom/signkey rotation *)
+let denomgroup_of_denomdata
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask= _;
+ h_pub= _;
+ master_sig;
+ revoked_sig= _;
+ } =
+ let master_sig = match master_sig with None -> assert false | Some v -> v in
+ let denoms =
+ [
+ RsaDenom.
+ {
+ rsa_pub= pub;
+ master_sig;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ lost= None;
+ };
+ ]
+ in
+ DenomGroup.Rsa
+ RsaDenomGroup.
+ { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
+
+let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
+ let version = Api.protocol_version in
+ let base_url = Config.base_url in
+ let currency = Config.currency in
+ let shopping_url = Config.shopping_url in
+ let open_banking_gateway = Config.open_banking_gateway_url in
+ let bank_compliance_language = Config.bank_compliance_language in
+ let currency_specification =
+ let v = Config.Currency.v in
+ let alt_unit_names =
+ Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+ in
+ CurrencySpecification.
+ {
+ name= v.name;
+ num_fractional_input_digits= v.fractional_input_digits;
+ num_fractional_normal_digits= v.fractional_normal_digits;
+ num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits;
+ alt_unit_names;
+ common_amounts= [];
+ }
+ in
+ let tiny_amount = Config.tiny_amount in
+ let stefan_abs = Config.stefan_abs in
+ let stefan_log = Config.stefan_log in
+ let stefan_lin = Config.stefan_lin in
+ (* todo asset_type
+ Type of the asset. "fiat", "crypto", "regional" or "stock". *)
+ let asset_type = "xxx" in
+ let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in
+ let* wire_fees =
+ (* todo
+ where does wire_methods comes from? *)
+ let wire_method = "xxx" in
+ let+ wire_fees =
+ Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti
+ in
+ String_map.singleton wire_method wire_fees
+ in
+ let wads =
+ (* TODO wads *)
+ []
+ in
+ let rewards_allowed = false in
+ let kyc_enabled = false in
+ let disable_direct_deposit = (* todo *) false in
+ let master_public_key = Config.master_public_key in
+ let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in
+ (* todo *)
+ let wallet_balance_limit_without_kyc = None in
+ let hard_limits = [] in
+ let zero_limits = [] in
+ let denom_data_l =
+ (* TODO sm-db *)
+ (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
+ Sm.get_denoms_data ()
+ in
+ let denom_data_l =
+ (* reverse chronological order *)
+ List.sort
+ (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start)
+ denom_data_l
+ in
+ let list_issue_date =
+ match denom_data_l with
+ | [] -> Time.Timestamp.never
+ | v :: _ -> v.Denom_data.stamp_start
+ in
+ let denominations =
+ let open Denom_data in
+ (* if `?last_issue_date` query param does not exactly match the `stamp_start`
+ of one of the denomination keys, all keys are returned *)
+ let l =
+ match last_issue_date with
+ | None -> denom_data_l
+ | Some last_issue_date -> (
+ match
+ List.find_opt
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date = 0)
+ denom_data_l
+ with
+ | None -> denom_data_l
+ | Some _ ->
+ List.filter
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
+ denom_data_l)
+ in
+ List.map denomgroup_of_denomdata l
+ in
+
+ let signkeys =
+ (* TODO sm-db
+ use database signkey data / verify secmod and database are in sync *)
+ (*
+ let now = Ptime_clock.now () |> Option.some in
+ let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
+ let signkey_data_l = Sm.get_signkeys_data () in
+ let signkey_data_l =
+ List.sort
+ (fun a b ->
+ let open Signkey_data in
+ Stdlib.compare b.stamp_start a.stamp_start)
+ signkey_data_l
+ in
+ List.filter_map
+ (fun Signkey_data.
+ {
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig;
+ revoked_sig= _;
+ } ->
+ match master_sig with
+ | None -> None
+ | Some master_sig ->
+ Some
+ SignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; master_sig })
+ signkey_data_l
+ in
+
+ let exchange_pub =
+ (* the eddsa pub key used to sign exchange_sig *)
+ match signkeys with
+ | [] -> Fmt.failwith "exchange has no active signkey"
+ | v :: _ -> v.SignKey.key
+ in
+ let exchange_sig =
+ (* Compact EdDSA signature (binary-only) over the
+ contatentation of all of the master_sigs (in reverse
+ chronological order by group) in the arrays under "denominations". *)
+ let hc =
+ denom_data_l
+ |> List.filter_map (fun v -> v.Denom_data.master_sig)
+ |> List.map Signatures.DenominationKeyValidity.to_octets
+ |> String.concat ""
+ |> Hash.H64.hash
+ in
+ let open Signatures.ExchangeKeySet in
+ sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc }
+ in
+
+ let recoup = (* TODO /recoup *) [] in
+ let* global_fees =
+ (* WIP DEBUG
+ Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti
+ *)
+ Ok []
+ 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
+
+(* TODO query param ?last_issue_date *)
+let f req server _env =
+ Logs.info (fun m -> m "GET /keys");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* last_issue_date =
+ match Vif.Queries.get req "last_issue_date" with
+ | [] -> Ok None
+ | v :: _ -> (
+ match int_of_string_opt v with
+ | None ->
+ Error
+ "invalid `?last_issue_date` query param, int_of_string failure"
+ | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n))))
+ in
+ let* v = mk_keys ~db_conn sm ~last_issue_date in
+ let s = Api.encode_exn jsont v in
+ Ok s
+ in
+ Respond_util.respond_with_res res req
diff --git a/.jjconflict-side-0/src/http_management.ml b/.jjconflict-side-0/src/http_management.ml
new file mode 100644
index 00000000..4b0aa352
--- /dev/null
+++ b/.jjconflict-side-0/src/http_management.ml
@@ -0,0 +1,750 @@
+open Syntax
+open Api
+open Hash
+
+module Keys_get = struct
+ let mk_future_denom (module Sm : Secmod.S) ~section_name
+ ({
+ 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= _;
+ } :
+ Denom_data.t) =
+ let denom_pub =
+ DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= 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:Sm.sign_with_sm_key
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+ in
+ FutureDenom.
+ {
+ section_name;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig;
+ }
+
+ let mk_future_signkey (module Sm : Secmod.S)
+ ({
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig= _;
+ revoked_sig= _;
+ } :
+ Signkey_data.t) =
+ 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:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration }
+ in
+ FutureSignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+
+ let mk_future_keys_response (module Sm : Secmod.S) =
+ let future_signkeys =
+ Sm.get_signkeys_data ()
+ |> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig)
+ |> List.map (fun signkey -> mk_future_signkey (module Sm) signkey)
+ in
+ let future_denoms =
+ Sm.get_denoms_data ()
+ |> List.filter (fun k -> Option.is_none k.Denom_data.master_sig)
+ |> List.map (fun dn_data ->
+ let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in
+ match opt with
+ | None -> Fmt.failwith "section_name not found."
+ | Some section_name ->
+ mk_future_denom (module Sm) ~section_name dn_data)
+ in
+ let master_pub = Config.Exchange.master_public_key in
+ let denom_secmod_public_key = Sm.get_sm_key_pub () in
+ let signkey_secmod_public_key = Sm.get_sm_key_pub () 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_util.respond_with_res res req
+end
+
+module Keys_post = struct
+ let verify_denom_signature (module Sm : Secmod.S)
+ DenomSignature.{ h_denom_pub; master_sig } =
+ let* denom =
+ match Sm.find_denom_data h_denom_pub with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some denom -> Ok denom
+ in
+ let 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:Sm.verify_with_master_key master_sig r
+
+ let verify_signkey_signature (module Sm : Secmod.S)
+ SignKeySignature.{ key; master_sig } =
+ let* signkey =
+ match Sm.find_signkey_data key with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some signkey -> Ok signkey
+ in
+ let open Signatures.ExchangeSigningKeyValidity in
+ let r : r =
+ {
+ start= signkey.stamp_start;
+ expire= signkey.stamp_expire;
+ end_= signkey.stamp_end;
+ signkey_pub= signkey.pub;
+ }
+ in
+ verify_f ~f:Sm.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 ()
+
+ (* TODO move to test *)
+ let check_master_signatures_update ~db_conn (module Sm : Secmod.S) =
+ Sm.get_denoms_data ()
+ |> list_iter (fun denom ->
+ let error = Error "update_master_signatures sanity check failure" in
+ let* opt =
+ Pg.find_denom db_conn denom.Denom_data.h_pub |> unwrap_err_caqti
+ in
+ let* v = match opt with None -> error | Some v -> Ok v in
+ let check = function false -> error | true -> Ok () in
+ let* () =
+ check (Timestamp.compare v.stamp_start denom.stamp_start = 0)
+ in
+ let* () = check (v.value = denom.value) in
+ let* () = check (v.fee_refund = denom.fee_refund) in
+ let* () = check (v.age_mask = denom.age_mask) in
+ Ok ())
+
+ let do_ ~db_conn (module Sm : Secmod.S)
+ MasterSignatures.{ denom_sigs; signkey_sigs } =
+ let* () =
+ signkey_sigs
+ |> List.map (fun SignKeySignature.{ key; master_sig } ->
+ (key, master_sig))
+ |> Sm.add_signkey_master_signatures
+ in
+ let* () =
+ denom_sigs
+ |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
+ (h_denom_pub, master_sig))
+ |> Sm.add_denom_master_signatures
+ in
+ let* () = Sm.store () in
+ let* () = check_master_signatures_update ~db_conn (module Sm) 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_util.respond_with_res res req
+end
+
+module Denom_revoke = struct
+ let verify (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let open Signatures.MasterDenominationKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let* () = Sm.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_util.respond_with_res res req
+end
+
+module Signkey_revoke = struct
+ let verify (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let open Signatures.MasterSigningKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let* () = Sm.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_util.respond_with_res res req
+end
+
+module Auditors = struct
+ let verify (module Sm : Secmod.S)
+ AuditorSetupMessage.
+ {
+ auditor_url;
+ auditor_name= _;
+ auditor_pub;
+ master_sig;
+ validity_start;
+ } =
+ let open Signatures.MasterAddAuditor in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date= validity_start;
+ auditor_pub;
+ h_auditor_url= Hash.Cstring.H64.hash auditor_url;
+ }
+
+ (* TODO timestamps last_change +/- checks *)
+ (* todo: there is something about use of monotonic time
+ + protection against replay attack that I don't understand *)
+ 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_util.respond_with_res res req
+end
+
+module Auditors_disable = struct
+ let verify (module Sm : Secmod.S) auditor_pub
+ AuditorTeardownMessage.{ master_sig; validity_end } =
+ let open Signatures.MasterDelAuditor in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module Wire_fee = struct
+ let verify (module Sm : Secmod.S)
+ WireFeeSetupMessage.
+ {
+ wire_method;
+ master_sig_wire;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ } =
+ let open Signatures.MasterWireFee in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module Global_fees = struct
+ let verify (module Sm : Secmod.S)
+ GlobalFees.
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ } =
+ (* TODO KYC
+ what is kyc_timeout, kyc_fee ? *)
+ let kyc_timeout = Time.Relative.forever in
+ let kyc_fee = Amount.dummy_value in
+ (* * *)
+ let open Signatures.GlobalFees in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ kyc_timeout;
+ history_expiration;
+ history_fee;
+ kyc_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 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_util.respond_with_res res req
+end
+
+module Wire = struct
+ let verify (module Sm : Secmod.S)
+ WireSetupMessage.
+ {
+ payto_uri;
+ master_sig_wire;
+ master_sig_add;
+ validity_start;
+ bank_label= _;
+ priority= _;
+ } =
+ (* TODO wire *)
+ let conversion_url = "" in
+ let credit_restrictions = "" in
+ let debit_restrictions = "" in
+ let* () =
+ let open Signatures.MasterWireDetails in
+ verify_f ~f:Sm.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:Sm.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 ->
+ (* TODO wire *)
+ let last_change = Timestamp.of_ptime (Ptime_clock.now ()) in
+ let v =
+ 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 |> 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_util.respond_with_res res req
+end
+
+module Wire_disable = struct
+ let verify (module Sm : Secmod.S)
+ WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
+ let open Signatures.MasterDelWire in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module Drain = struct
+ let verify (module Sm : Secmod.S)
+ DrainProfitsMessage.
+ {
+ debit_account_section;
+ credit_payto_uri;
+ wtid;
+ master_sig;
+ date;
+ amount;
+ } =
+ let open Signatures.MasterDrainProfit in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module AmlOfficer = struct
+ let verify (module Sm : Secmod.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:Sm.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_util.respond_with_res res req
+end
+
+module Partners = struct
+ let verify (module Sm : Secmod.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:Sm.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_util.respond_with_res res req
+end
diff --git a/.jjconflict-side-0/src/mte.ml b/.jjconflict-side-0/src/mte.ml
new file mode 100644
index 00000000..f98ee88f
--- /dev/null
+++ b/.jjconflict-side-0/src/mte.ml
@@ -0,0 +1,77 @@
+(* 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 tos =
+ let v s = rel / s in
+ [
+ get_ rel --> hello;
+ get_ (v "terms") --> Static.terms;
+ get_ (v "privacy") --> Static.privacy;
+ ]
+ in
+ let status_info = [ get_ (rel / "keys") --> Http_keys.f ] in
+ let management =
+ let open Http_management in
+ let v s = rel / "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.secmod ] 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
new file mode 100644
index 00000000..cd2c141a
--- /dev/null
+++ b/.jjconflict-side-0/src/parse_config.ml
@@ -0,0 +1,262 @@
+(* parse config file
+ 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 whitespace = skip_while is_whitespace
+
+module Parse_data = struct
+ type line =
+ | 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 take_till_end_of_line =
+ take_till is_eol >>= fun s -> return s <* end_of_line
+
+ let blank = whitespace <* end_of_line >>| fun () -> Blank
+
+ let comment =
+ whitespace *> (char '#' <|> char '%') *> take_till_end_of_line >>| fun s ->
+ Comment s
+
+ let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s
+
+ let item_value =
+ let unquoted_value =
+ take_while1 (fun c -> not (is_whitespace c || is_eol c))
+ in
+ let quoted_value =
+ char '"' *> take_till is_eol >>= fun s ->
+ match String.ends_with ~suffix:"\"" 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
+ (whitespace *> char '=' *> whitespace *> item_value)
+ <* end_of_line
+
+ let config = many (choice [ blank; 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 Pp_debug = struct
+ let pp_item ppf { key; value } =
+ let open Fmt in
+ match String.contains value '"' || String.contains value ' ' with
+ | false -> pf ppf "%s = %s" key value
+ | true -> pf ppf "%s = \"%s\"" key value
+
+ let pp_line ppf line =
+ let open Fmt in
+ let open Parse_data in
+ match line with
+ | Blank -> Fmt.nop ppf ()
+ | Comment s -> pf ppf "#%s" s
+ | Header s -> pf ppf "[%s]" s
+ | Item item -> pf ppf "%a" pp_item item
+
+ let _pp_lines ppf raw_line_l =
+ let open Fmt in
+ pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l
+
+ let pp_section ppf { header; items } =
+ let open Fmt in
+ pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items
+
+ let pp_config ppf l =
+ let open Fmt in
+ pf ppf "%a" (list ~sep:(any "\n") pp_section) l
+end
+[@@ocaml.warning "-32"]
+
+module Parse_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 = whitespace *> integer in
+ let dunit =
+ whitespace *> 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 ptime_span_of_int64 i =
+ match Ptime.Span.of_float_s (Int64.to_float i) with
+ | None ->
+ fail "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i
+ | Some ts -> ts
+
+ let to_time_span t =
+ let acc =
+ List.fold_left
+ (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
+ 0 t
+ in
+ let acc = Int64.of_int acc in
+ Time.Relative.of_s acc
+
+ 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_res = 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_res
+let duration s = Parse_duration.(s |> parse |> to_time_span)
+
+let ed25519 s =
+ s
+ |> B32.decode
+ |> unwrap_res
+ |> Mirage_crypto_ec.Ed25519.pub_of_octets
+ |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
+ |> unwrap_res
+
+(* 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
new file mode 100644
index 00000000..32428045
--- /dev/null
+++ b/.jjconflict-side-0/src/pg.ml
@@ -0,0 +1,374 @@
+(* TODO
+
+ check there is no issues with signed/unsigned integers
+
+ how to fix postgres/caqti tuple type?
+ try something with OID?
+ need to add boilerplate in each query for amounts
+
+ GNU Taler db-events?
+ it seems caqti/pgx does not support it
+
+ transaction
+
+ should check validity of signatures got from db, for /management at least
+
+ clean up caqti error type *)
+(* TODO time
+ fix comparison with timestamp footgun *)
+
+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.(denomination_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 denomination_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 denomination_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 denomination_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 =
+ (* TODO check syntax on this *)
+ 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
new file mode 100644
index 00000000..0a2e8f15
--- /dev/null
+++ b/.jjconflict-side-0/src/pg_type.ml
@@ -0,0 +1,377 @@
+(* this module defines caqti encoding/decodings *)
+open Caqti_type
+open Crypto
+open Api
+
+(* TODO
+ check that we use Caqti_type.octets for binary data *)
+
+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 denomination_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_data.
+ { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
+ ->
+ match master_sig with
+ | None -> Error "signkey_data master_sig is none"
+ | Some master_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= Some 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
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig;
+ revoked_sig;
+ }
+ ->
+ match master_sig with
+ | None -> Error "denom_data master_sig is none"
+ | Some master_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= Some master_sig;
+ revoked_sig;
+ })
+ (t12 rsa_pub amount time time time time amount amount amount amount int
+ (t3 denomination_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_util.ml b/.jjconflict-side-0/src/respond_util.ml
new file mode 100644
index 00000000..3c4faf5d
--- /dev/null
+++ b/.jjconflict-side-0/src/respond_util.ml
@@ -0,0 +1,22 @@
+let respond_with_plain_text_error ?status e req =
+ let open Vif.Response in
+ let open Syntax in
+ let status = Option.value ~default:`Bad_request status in
+ let* () = add ~field:"content-type" "text/plain; charset=utf-8" in
+ let* () = with_string req e in
+ respond status
+
+let respond_with_ok_json content req =
+ let open Vif.Response in
+ let open Syntax in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string req content in
+ respond `OK
+
+let respond_with_res res req =
+ match res with
+ | Error err ->
+ Logs.err (fun m -> m "%s." err);
+ let err = Fmt.str "%s@." err in
+ respond_with_plain_text_error err req
+ | Ok content -> respond_with_ok_json content req
diff --git a/.jjconflict-side-0/src/secmod.ml b/.jjconflict-side-0/src/secmod.ml
new file mode 100644
index 00000000..ed74310f
--- /dev/null
+++ b/.jjconflict-side-0/src/secmod.ml
@@ -0,0 +1,407 @@
+module type S = sig
+ open Crypto
+
+ 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
+
+ (* TODO query database instead? *)
+ val get_sm_key_pub : unit -> eddsa_pub
+ val get_signkeys_data : unit -> Signkey_data.t list
+ val get_denoms_data : unit -> Denom_data.t list
+ val find_signkey_data : eddsa_pub -> Signkey_data.t option
+ val find_denom_data : denomination_hash -> Denom_data.t option
+ val find_denom_section_name : denomination_hash -> string option
+
+ (* - management operations - *)
+ (* TODO
+ problem of keeping db and secmod state syncronized
+ do db interaction from secmod? *)
+
+ val add_signkey_master_signatures :
+ (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list ->
+ (unit, string) result
+
+ val add_denom_master_signatures :
+ (denomination_hash * Signatures.DenominationKeyValidity.t) list ->
+ (unit, string) result
+
+ val revoke_signkey :
+ eddsa_pub ->
+ Signatures.MasterSigningKeyRevocation.t ->
+ (unit, string) result
+
+ val revoke_denomination :
+ denomination_hash ->
+ Signatures.MasterDenominationKeyRevocation.t ->
+ (unit, string) result
+
+ val store : unit -> (unit, string) result
+end
+
+module Make (Conn : Pg.CONN) = struct
+ (* TODO
+ - key rotation
+ - how many signkey to use?
+ we just use 1 for now
+ - does the secmod's own key as metadata/expiration date?
+ - something to refer to valid sk/dn
+
+ - eddsa.ml with phantom type for key-kind + signed-data-kind *)
+ open Syntax
+ open Crypto
+
+ type signkey = {
+ priv: eddsa_priv;
+ sk_data: Signkey_data.t;
+ }
+
+ type denom = {
+ priv: rsa_priv;
+ dn_data: Denom_data.t;
+ }
+
+ type t = {
+ lock: Miou.Mutex.t;
+ sm_key_priv: eddsa_priv;
+ sm_key_pub: eddsa_pub;
+ sk_ht: (eddsa_pub, signkey) Hashtbl.t;
+ dn_ht: (denomination_hash, denom) Hashtbl.t;
+ dn_section_name_ht: (denomination_hash, string) Hashtbl.t;
+ }
+
+ let dir = Fpath.(v "data" / "secmod")
+
+ let db_lookup_signkey_data conn fname pub =
+ let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
+ match opt with
+ | None ->
+ Fmt.error
+ "load_signkey error, no associated data found in database for \
+ signkey `%s`."
+ (Fpath.to_string fname)
+ | Some sk_data -> Ok sk_data
+
+ let db_lookup_denom_data conn ~section_name priv =
+ let pub = RsaPrivateKey.pub_of_priv priv in
+ let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+ let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
+ match opt with
+ | None ->
+ Fmt.error
+ "load_denom error no associated metadata found in database for \
+ denomination `%s`."
+ section_name
+ | Some dn_data -> Ok dn_data
+
+ let load_signkey conn fname =
+ let* opt = Data_file.read_eddsa fname in
+ match opt with
+ | None -> Ok None
+ | Some priv ->
+ let pub = EddsaPrivateKey.pub_of_priv priv in
+ let* sk_data = db_lookup_signkey_data conn fname pub in
+ let signkey = { priv; sk_data } in
+ Ok (Some signkey)
+
+ let load conn =
+ let error_invalid_state =
+ Fmt.error "secmod load error: invalid store state."
+ in
+ let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sk_sm") in
+ let* signkeys =
+ let l = List.init 1 (fun i -> Fpath.(dir / Fmt.str "sk_%d" i)) in
+ let* l = list_map (fun fname -> load_signkey conn fname) l in
+ match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
+ in
+ let dn_section_name_ht = Hashtbl.create 0xff in
+ let* denoms =
+ let* l =
+ let open Config.Coin in
+ list_map
+ (fun coin ->
+ let section_name = coin.section_name in
+ let fname = Fpath.(dir / section_name) in
+ let* opt = Data_file.read_rsa fname in
+ match opt with
+ | None -> Ok None
+ | Some priv ->
+ (* todo: could check that coin config match db values *)
+ let* dn_data = db_lookup_denom_data conn ~section_name priv in
+ Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name;
+ let denom = { priv; dn_data } in
+ Ok (Some denom))
+ all_coins
+ in
+ match Syntax.opt_list l with
+ | Error () -> error_invalid_state
+ | Ok opt -> Ok opt
+ in
+ match (sm_key_priv, signkeys, denoms) with
+ | None, None, None -> Ok None
+ | Some sm_key_priv, Some signkeys, Some denoms ->
+ let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
+ let lock = Miou.Mutex.create () in
+ let sk_ht =
+ signkeys
+ |> List.map (fun v -> (v.sk_data.pub, v))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ let dn_ht =
+ denoms
+ |> List.map (fun v -> (v.dn_data.h_pub, v))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ Ok
+ (Some
+ { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht })
+ | _, _, _ -> error_invalid_state
+
+ let make_new_signkey () =
+ 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 = Time.Timestamp.of_absolute start in
+ let stamp_expire = Time.Timestamp.of_absolute expire in
+ let stamp_end = stamp_expire in
+ let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
+ let master_sig = None in
+ let revoked_sig = None in
+ let sk_data =
+ Signkey_data.
+ { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
+ in
+ { priv; sk_data }
+
+ let make_new_denom
+ 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 open Time in
+ let start = Absolute.of_ptime (Ptime_clock.now ()) in
+ let stamp_start = Timestamp.of_absolute start in
+ let stamp_expire_withdraw =
+ Timestamp.of_absolute @@ Absolute.add start duration_withdraw
+ in
+ let stamp_expire_deposit =
+ Timestamp.of_absolute @@ Absolute.add start duration_spend
+ in
+ let stamp_expire_legal =
+ Timestamp.of_absolute @@ Absolute.add start duration_legal
+ in
+
+ let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in
+ let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+ let master_sig = None in
+ let revoked_sig = None in
+ let dn_data =
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask= 0;
+ h_pub;
+ master_sig;
+ revoked_sig;
+ }
+ in
+ { priv; dn_data }
+
+ let make_new () =
+ let lock = Miou.Mutex.create () in
+ let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
+ let sk_ht =
+ [ make_new_signkey () ]
+ |> List.map (fun v -> (v.sk_data.pub, v))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ let dn_section_name_ht = Hashtbl.create 0xff in
+ let dn_ht =
+ Config.Coin.all_coins
+ |> List.map (fun coin ->
+ let denom = make_new_denom coin in
+ Hashtbl.replace dn_section_name_ht denom.dn_data.h_pub
+ coin.section_name;
+ (denom.dn_data.h_pub, denom))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }
+
+ let t =
+ match load (module Conn) with
+ | Ok None ->
+ let t = make_new () in
+ Logs.info (fun m -> m "secmod initialized with fresh keys");
+ t
+ | Ok (Some t) ->
+ Logs.info (fun m -> m "secmod initialized from storage");
+ t
+ | Error e -> Fmt.failwith "secmod init failure: %s." e
+
+ (* note: don't expose a signing function if we want a real "security module" one day *)
+ let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s
+ let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_key_pub s ~msg
+
+ let verify_with_master_key s ~msg =
+ EddsaSignature.verify ~key:Config.master_public_key s ~msg
+
+ (* TODO
+ - do something to force `pub` to be one of the valid signkey
+ how to handle revocation?
+ raise exn for now *)
+ let sign_with_signkey ~pub s =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.sk_ht pub with
+ | None -> Fmt.failwith "secmod failure: public key not found."
+ | Some signkey ->
+ let v = EddsaSignature.sign ~key:signkey.priv s in
+ v
+
+ let verify_with_signkey ~pub s ~msg =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.sk_ht pub with
+ | None -> Error "secmod failure: public key not found."
+ | Some signkey -> EddsaSignature.verify ~key:signkey.sk_data.pub s ~msg
+
+ let get_sm_key_pub () = t.sm_key_pub
+
+ let get_signkeys () =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ Hashtbl.to_seq_values t.sk_ht |> List.of_seq
+
+ let get_denoms () =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ Hashtbl.to_seq_values t.dn_ht |> List.of_seq
+
+ let find_signkey pub =
+ Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub
+
+ let find_denom h_denom =
+ Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.dn_ht h_denom
+
+ let get_signkeys_data () = get_signkeys () |> List.map (fun v -> v.sk_data)
+ let get_denoms_data () = get_denoms () |> List.map (fun v -> v.dn_data)
+
+ let find_signkey_data pub =
+ find_signkey pub |> Option.map (fun v -> v.sk_data)
+
+ let find_denom_data h_denom =
+ find_denom h_denom |> Option.map (fun v -> v.dn_data)
+
+ let find_denom_section_name h_denom =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ Hashtbl.find_opt t.dn_section_name_ht h_denom
+
+ let add_signkey_master_signatures l =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ list_iter
+ (fun (pub, master_sig) ->
+ match Hashtbl.find_opt t.sk_ht pub with
+ | None -> Error "secmod failure: public key not found."
+ | Some signkey ->
+ let sk_data =
+ { signkey.sk_data with master_sig= Some master_sig }
+ in
+ let signkey = { signkey with sk_data } in
+ let* () =
+ Pg.insert_signkey (module Conn) sk_data |> unwrap_err_caqti
+ in
+ Hashtbl.replace t.sk_ht pub signkey;
+ Ok ())
+ l
+
+ let add_denom_master_signatures l =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ list_iter
+ (fun (h_denom_pub, master_sig) ->
+ match Hashtbl.find_opt t.dn_ht h_denom_pub with
+ | None -> Error "secmod failure: denomination hash not found."
+ | Some denom ->
+ let dn_data = { denom.dn_data with master_sig= Some master_sig } in
+ let denom = { denom with dn_data } in
+ let* () =
+ Pg.insert_denom (module Conn) dn_data |> unwrap_err_caqti
+ in
+ Hashtbl.replace t.dn_ht h_denom_pub denom;
+ Ok ())
+ l
+
+ let revoke_signkey exchange_pub revoked_sig =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.sk_ht exchange_pub with
+ | None -> Error "secmod failure: denomination hash not found."
+ | Some signkey ->
+ let sk_data = { signkey.sk_data with revoked_sig= Some revoked_sig } in
+ let signkey = { signkey with sk_data } in
+ Hashtbl.replace t.sk_ht exchange_pub signkey;
+ Ok ()
+
+ let revoke_denomination h_denom_pub revoked_sig =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.dn_ht h_denom_pub with
+ | None -> Error "secmod failure: denomination hash not found."
+ | Some denom ->
+ let dn_data = { denom.dn_data with revoked_sig= Some revoked_sig } in
+ let denom = { denom with dn_data } in
+ Hashtbl.replace t.dn_ht h_denom_pub denom;
+ Ok ()
+
+ let store () =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ let* () = Data_file.write_eddsa Fpath.(dir / "sk_sm") t.sm_key_priv in
+ let* () =
+ Hashtbl.to_seq_values t.sk_ht
+ |> List.of_seq
+ |> List.mapi (fun i (key : signkey) ->
+ let fname = Fpath.(dir / Fmt.str "sk_%d" i) in
+ (fname, key.priv))
+ |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
+ in
+ let* () =
+ let* l =
+ Hashtbl.to_seq_values t.dn_ht
+ |> List.of_seq
+ |> Syntax.list_map (fun (key : denom) ->
+ let+ section_name =
+ match Hashtbl.find_opt t.dn_section_name_ht key.dn_data.h_pub with
+ | None -> Error "invalid state, section_name not found"
+ | Some s -> Ok s
+ in
+ let fname = Fpath.(dir / section_name) in
+ (fname, key.priv))
+ in
+ list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l
+ in
+ Logs.info (fun m -> m "stored secmod data to file");
+ Ok ()
+end
diff --git a/.jjconflict-side-0/src/secmod.mli b/.jjconflict-side-0/src/secmod.mli
new file mode 100644
index 00000000..0205b866
--- /dev/null
+++ b/.jjconflict-side-0/src/secmod.mli
@@ -0,0 +1,46 @@
+module type S = sig
+ open Crypto
+
+ 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
+
+ (* TODO query database instead? *)
+ val get_sm_key_pub : unit -> eddsa_pub
+ val get_signkeys_data : unit -> Signkey_data.t list
+ val get_denoms_data : unit -> Denom_data.t list
+ val find_signkey_data : eddsa_pub -> Signkey_data.t option
+ val find_denom_data : denomination_hash -> Denom_data.t option
+ val find_denom_section_name : denomination_hash -> string option
+
+ (* - management operations - *)
+ (* TODO
+ problem of keeping db and secmod state syncronized
+ do db interaction from secmod? *)
+
+ val add_signkey_master_signatures :
+ (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list ->
+ (unit, string) result
+
+ val add_denom_master_signatures :
+ (denomination_hash * Signatures.DenominationKeyValidity.t) list ->
+ (unit, string) result
+
+ val revoke_signkey :
+ eddsa_pub ->
+ Signatures.MasterSigningKeyRevocation.t ->
+ (unit, string) result
+
+ val revoke_denomination :
+ denomination_hash ->
+ Signatures.MasterDenominationKeyRevocation.t ->
+ (unit, string) result
+
+ val store : unit -> (unit, string) result
+end
+
+module Make (_ : Pg.CONN) : S
diff --git a/.jjconflict-side-0/src/signatures.ml b/.jjconflict-side-0/src/signatures.ml
new file mode 100644
index 00000000..06f44cee
--- /dev/null
+++ b/.jjconflict-side-0/src/signatures.ml
@@ -0,0 +1,1314 @@
+open Hash
+module Taler_signatures = Include.Taler_signatures
+
+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 sign_f ~f r = f (Bin.to_string R.bin r)
+ let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin 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
+ (* TODO 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 debug sig
+ missing field from 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
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *)
+ type r = {
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ purse_timeout: TimeRelativeNBO.t;
+ kyc_timeout: TimeRelativeNBO.t;
+ history_expiration: TimeRelativeNBO.t;
+ history_fee: AmountNBO.t;
+ kyc_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
+ kyc_timeout
+ history_expiration
+ history_fee
+ kyc_fee
+ account_fee
+ purse_fee
+ purse_account_limit
+ ->
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ kyc_timeout;
+ history_expiration;
+ history_fee;
+ kyc_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.kyc_timeout)
+ |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration)
+ |+ field AmountNBO.bin (fun t -> t.history_fee)
+ |+ field AmountNBO.bin (fun t -> t.kyc_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_data.ml b/.jjconflict-side-0/src/signkey_data.ml
new file mode 100644
index 00000000..22a7a0cd
--- /dev/null
+++ b/.jjconflict-side-0/src/signkey_data.ml
@@ -0,0 +1,10 @@
+open Crypto
+
+type t = {
+ pub: eddsa_pub;
+ stamp_start: Timestamp.t;
+ stamp_expire: Timestamp.t;
+ stamp_end: Timestamp.t;
+ master_sig: Signatures.ExchangeSigningKeyValidity.t option;
+ revoked_sig: Signatures.MasterSigningKeyRevocation.t option;
+}
diff --git a/.jjconflict-side-0/src/static.ml b/.jjconflict-side-0/src/static.ml
new file mode 100644
index 00000000..52a7278d
--- /dev/null
+++ b/.jjconflict-side-0/src/static.ml
@@ -0,0 +1,115 @@
+(* TODO check for mathcing ETAG with a middleware instead? *)
+(* /terms + /privacy
+ - try to find a response with an acceptable mime-type
+ - pick the version in the most preferred language of the user
+ - apply compression if that is allowed by the client
+ - set ETAG header
+ - If it did not change, a "304 Not Modified" response will be returned
+ - A "Taler-Terms-Version" header is generated to indicate the legal version of the terms
+ - When returning a full response (not a "304 Not Modified"),
+ include a "Avail-Languages" header: a comma-separated list of the languages available *)
+
+module Respond_with = struct
+ open Vif.Response
+ open Syntax
+
+ open struct
+ let error_detail ?hint _status =
+ let open Api in
+ let code = -1 in
+ let err = ErrorDetail.make ?hint code in
+ let s = encode_exn ErrorDetail.jsont err in
+ Logs.err (fun m -> m "ErrorDetail: `%s`" s);
+ s
+ end
+
+ let bad_request ?hint req =
+ let body = error_detail ?hint `Bad_request in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string ?compression:None req body in
+ respond `Bad_request
+
+ let not_modified () =
+ let* () = empty in
+ respond `Not_modified
+
+ let unsupported_media_type req =
+ let body =
+ error_detail ~hint:"no acceptable mimetype" `Unsupported_media_type
+ in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = add ~field:"accept" Headers.accept_header_value in
+ let* () = with_string ?compression:None req body in
+ respond `Unsupported_media_type
+end
+
+let _aux kind req _server _env =
+ let etag = Assets.etag kind 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.Etag.parse s |> Result.map (Headers_lib.Etag.evaluate etag)
+ in
+ match has_matching_etag with
+ | Error e ->
+ Logs.err (fun m -> m "bad request");
+ Respond_with.bad_request ~hint:e req
+ | Ok true ->
+ Logs.err (fun m -> m "not modified");
+ Respond_with.not_modified ()
+ | Ok false -> (
+ match Headers.select_mimetype headers with
+ | None ->
+ Logs.err (fun m -> m "unsupported_media_type");
+ Respond_with.unsupported_media_type req
+ | Some mime ->
+ let lang = Headers.select_language headers in
+ let compression = Headers.select_encoding headers in
+ let data = Assets.get_content ~mime ~lang kind 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_value etag in
+ add ~field:"etag" etag_field_value
+ in
+ let* () =
+ (* todo: is it "taler-privacy-version" for /policy ? *)
+ add ~field:"taler-terms-version" Assets.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 mime in
+ add ~field:"content-type" content_type
+ in
+ respond `OK)
+
+(* WIP DEBUG *)
+let aux _kind req _server _env =
+ let open Vif.Response in
+ let open Syntax in
+ let data = "uhuh" in
+ let etag = "0" in
+ let content_type = "text/plain" in
+ let* () = with_string req data in
+ let* () = add ~field:"etag" etag in
+ let* () =
+ (* todo: is it "taler-privacy-version" for /policy ? *)
+ add ~field:"taler-terms-version" Assets.terms_legal_version
+ in
+ let* () = add ~field:"avail-languages" Headers.avail_languages_header_value in
+ let* () = add ~field:"content-type" content_type 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/syntax.ml b/.jjconflict-side-0/src/syntax.ml
new file mode 100644
index 00000000..c61aba15
--- /dev/null
+++ b/.jjconflict-side-0/src/syntax.ml
@@ -0,0 +1,51 @@
+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/time.ml b/.jjconflict-side-0/src/time.ml
new file mode 100644
index 00000000..3c5af371
--- /dev/null
+++ b/.jjconflict-side-0/src/time.ml
@@ -0,0 +1,151 @@
+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
new file mode 100644
index 00000000..180df904
--- /dev/null
+++ b/.jjconflict-side-0/src/time.mli
@@ -0,0 +1,54 @@
+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
new file mode 100644
index 00000000..1a942758
--- /dev/null
+++ b/.jjconflict-side-0/src/timestamp.ml
@@ -0,0 +1 @@
+include Time.Timestamp
diff --git a/.jjconflict-side-0/src/util.ml b/.jjconflict-side-0/src/util.ml
new file mode 100644
index 00000000..c690a009
--- /dev/null
+++ b/.jjconflict-side-0/src/util.ml
@@ -0,0 +1,62 @@
+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/dune b/.jjconflict-side-0/test/dune
new file mode 100644
index 00000000..1eefa8ef
--- /dev/null
+++ b/.jjconflict-side-0/test/dune
@@ -0,0 +1,11 @@
+(test
+ (name test)
+ (modules test)
+ (libraries mte fmt))
+
+; TODO
+; cram test?
+; gcc -o a.out ./test/signatures.c && ./a.out > a.output
+; rm ./a.out
+; dune exec ./test/test.exe > b.output
+; cmp -l a.output b.output
diff --git a/.jjconflict-side-0/test/offline_management.sh b/.jjconflict-side-0/test/offline_management.sh
new file mode 100755
index 00000000..a4999491
--- /dev/null
+++ b/.jjconflict-side-0/test/offline_management.sh
@@ -0,0 +1,45 @@
+#!/bin/bash
+
+set -e
+
+a="tmp_a.json"
+b="tmp_b.json"
+
+auditor_pub=$(<"./data/auditor_public_key")
+zero_euro="EUR:0.0"
+
+dune exec offline -- download --output $a
+dune exec offline -- sign --input $a --output $b
+dune exec offline -- upload --input $b --url "/management/keys"
+
+dune exec offline -- enable-auditor \
+--output $b \
+--auditor_url "auditor.example.com" \
+--auditor_name "auditor example" \
+--auditor_pub $auditor_pub \
+--validity_start 0
+dune exec offline -- upload --input $b --url "/management/auditors"
+
+dune exec offline -- wire-fee \
+--output $b \
+--wire_method "magic" \
+--fee_start 0 \
+--fee_end 99999999 \
+--closing_fee $zero_euro \
+--wire_fee $zero_euro
+dune exec offline -- upload --input $b --url "/management/wire-fee"
+
+dune exec offline -- global-fees \
+--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
+dune exec offline -- upload --input $b --url "/management/global-fees"
+
+rm $a
+rm $b
diff --git a/.jjconflict-side-0/test/signatures.c b/.jjconflict-side-0/test/signatures.c
new file mode 100644
index 00000000..bcebe993
--- /dev/null
+++ b/.jjconflict-side-0/test/signatures.c
@@ -0,0 +1,55 @@
+#include
+#include
+
+struct H64 {
+ uint8_t hash[64];
+};
+struct Hhh {
+ struct H64 hash;
+};
+struct Purpose {
+ uint32_t size;
+ uint32_t purpose;
+};
+
+struct PS {
+ struct Purpose purpose;
+ struct Hhh h;
+ uint32_t noreveal_index;
+};
+
+int main(void) {
+ struct Purpose purpose;
+ struct PS ps;
+
+ purpose.size = 3 * 4 + 64;
+ purpose.purpose = 1050;
+
+ struct Hhh h = {
+ .hash = {
+ .hash = {
+ 1 , 2 , 3 , 4 , 5, 6, 7, 8,
+ 9 , 10, 11, 12, 13, 14, 15, 16,
+ 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, 40,
+ 41, 42, 43, 44, 45, 46, 47, 48,
+ 49, 50, 51, 52, 53, 54, 55, 56,
+ 57, 58, 59, 60, 61, 62, 63, 64
+ }
+ }
+ };
+
+ uint32_t noreveal_index = 0;
+
+ ps.purpose = purpose;
+ ps.h = h;
+ ps.noreveal_index = noreveal_index;
+
+
+ fwrite(&ps, sizeof(ps), 1, stdout);
+
+ // printf("\n");
+
+ return 0;
+}
diff --git a/.jjconflict-side-0/test/test.ml b/.jjconflict-side-0/test/test.ml
new file mode 100644
index 00000000..21803e30
--- /dev/null
+++ b/.jjconflict-side-0/test/test.ml
@@ -0,0 +1,128 @@
+let () = Mirage_crypto_rng_unix.use_default ()
+let get_ok = function Error e -> failwith e | Ok v -> v
+
+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 |> get_ok in
+ assert (to_octets priv = to_octets priv')
+ in
+ let () =
+ let open Crypto.RsaPublicKey in
+ let pub' = pub |> to_octets |> of_octets |> 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 |> get_ok in
+ let decode v = decode jsont v |> 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.Etag in
+ let check input = assert (Result.is_ok (parse input)) in
+ let check_bad input = assert (Result.is_error (parse input)) in
+
+ check "*";
+ check "\"foo\"";
+ check "W/\"foo\"";
+ check "\"foo\", \"bar\"";
+ check " W/\"x\" , W/\"y\" , \"z\" ";
+ check " \"one\" , \"two\" , \"three\" ";
+ check "W/\"a\"";
+ check " W/\"a\" , \"b\"";
+
+ check_bad "";
+ check_bad "foo";
+ check_bad "W/foo";
+ check_bad "W/\"unterminated";
+ check_bad "\"foo\", W/";
+ check_bad "* , \"bar\"";
+ check_bad "\"a\" \"b\"";
+ check_bad "W/\"a\" W/\"b\"";
+ check_bad "\"fo\x7Fo\"";
+
+ (* TODO trailing comma are valid actually, I think *)
+ check_bad "\"foo\" ,";
+ check_bad ", \"foo\"";
+ ()
+
+(*
+
+let () =
+ let open Binary_formats.WithdrawConfirmationPS in
+ let str64 = String.init 64 (fun i -> Char.unsafe_chr (i + 1)) in
+ let dummy_t = { h_planchets= { hash= str64 }; noreveal_index= 0_l } in
+ let size = Bin.size_of_value bin dummy_t |> Option.get in
+ assert (size = 76);
+
+ (* for cmp test with signatures.c output *)
+ (*
+ let raw_str = Bin.to_string bin dummy_t in
+ Printf.printf "%s" raw_str;
+ *)
+ ()
+ *)
+
+let () =
+ let v =
+ "04000274VF2F65WWABKGZYHREQWAFTVPMWEK9EQYMCPP1E6CMC224XDDDBVM7NRMNDX3TETHTK5G7GPPPYGN08FEMSY6B7NGBE8AYMG5HWT2BXRSAHAWDWW5Y16YVGXJG0BCKW3X17EWEF8MNGFGJBKVWQV5WPT0R2QK82QXFHFVGP3HR1D8HF69JXBC22B62M4SFETRJNXRG2GXX03BETSNQW0X7BYTMFJX5JQH4B2KJMABB02RFSNNMND7CT7MSAX5SCZY5ZB9XS4ZDKA9AVTS11V790KXXBSFZSD3NNEHKB6RS99RJD3MDJE04G1Q83HR50N5NVBDW3HPJZKQS5SSG7R2R2F7K8P06HJ4YSQFF52GF3RZW22N4FRQ28KQ2JZMZ1GJS1KBNHNNMS1RW9DZQ3882Z5V0000000004002==="
+ in
+ let decode s = B32.decode s |> get_ok in
+ let v' = B32.encode (decode v) in
+ let v'' = B32.encode (decode v') in
+ (*
+ Fmt.pr "v : %s@." v;
+ Fmt.pr "v' : %s@." v';
+ Fmt.pr "v'': %s@." v'';
+ Fmt.pr "len v : %d@." (String.length v);
+ Fmt.pr "len v' : %d@." (String.length v');
+ Fmt.pr "len v'': %d@." (String.length v'');
+ *)
+ assert (v = v');
+ assert (v' = v'');
+ ()
diff --git a/.jjconflict-side-0/tools/dune b/.jjconflict-side-0/tools/dune
new file mode 100644
index 00000000..f500902e
--- /dev/null
+++ b/.jjconflict-side-0/tools/dune
@@ -0,0 +1,7 @@
+(executable
+ (public_name offline)
+ (name offline)
+ (modules offline offline_impl offline_sig)
+ (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
+
+; todo depends on curl
diff --git a/.jjconflict-side-0/tools/offline.ml b/.jjconflict-side-0/tools/offline.ml
new file mode 100644
index 00000000..f40664fd
--- /dev/null
+++ b/.jjconflict-side-0/tools/offline.ml
@@ -0,0 +1,313 @@
+(* TODO
+ all management operations:
+ /management/wire
+ /management/wire/disable
+ -> how to build WireSetupMessage?
+ we need additional data to craft master_sig
+ maybe supposed to be found in the full payto-uri?
+
+ /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 default_master_offline_key_file = "data/master_offline_private_key"
+(*
+let default_response_file = "response.json"
+let default_request_file = "request.json"
+*)
+
+let master_key =
+ let doc = "Master offline Eddsa private key file." in
+ Arg.(
+ value
+ & opt file default_master_offline_key_file
+ & info [ "master_key_file" ] ~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" in
+ let output =
+ let doc = "output file" in
+ Arg.(
+ value
+ & opt filepath default_master_offline_key_file
+ & info [ "o"; "output" ] ~doc)
+ in
+ Cmd.make (Cmd.info "setup" ~doc)
+ @@
+ let+ output = output in
+ setup ~output
+
+let download_cmd =
+ let doc = "GET /management/keys/" in
+ let man =
+ [ `S Manpage.s_description; `P "$(cmd) download /management/keys." ]
+ in
+ Cmd.make (Cmd.info "download" ~doc ~man)
+ @@
+ let+ output = output in
+ download ~output
+
+let upload_cmd =
+ let doc = "POST input.json data to url (default /management/keys)" 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
new file mode 100644
index 00000000..3438ec66
--- /dev/null
+++ b/.jjconflict-side-0/tools/offline_impl.ml
@@ -0,0 +1,230 @@
+open Syntax
+open Hash
+
+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 base_url = Uri.of_string "http://localhost:3434/"
+let full_url path = Uri.with_path base_url path |> Uri.to_string
+
+let download ~output =
+ let open Bos in
+ let uri = full_url "/management/keys/" in
+ OS.Cmd.run Cmd.(v "curl" % "-s" % "-o" % output % "-X" % "GET" % uri)
+ |> unwrap_err_msg
+
+let upload ~input ~url =
+ let open Bos in
+ let uri = full_url url in
+ OS.Cmd.run
+ Cmd.(
+ v "curl"
+ % "-i"
+ % "-X"
+ % "POST"
+ % "-H"
+ % "Content-Type: application/json"
+ % "--data"
+ % ("@" ^ input)
+ % uri)
+ |> unwrap_err_msg
+
+let setup ~output =
+ let () = Mirage_crypto_rng_unix.use_default () in
+ let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
+ Fmt.pr "generated master public key:@\n%s@."
+ (Mirage_crypto_ec.Ed25519.pub_to_octets pub |> B32.encode);
+ let priv_data = Mirage_crypto_ec.Ed25519.priv_to_octets priv in
+ write_file output priv_data
+
+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* () =
+ Offline_sig.verify_future_keys_response master_pub future_keys_response
+ in
+ let master_signatures =
+ Offline_sig.mk_future_keys ~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
+ (* TODO KYC *)
+ let kyc_timeout = Time.Relative.forever in
+ let kyc_fee = Amount.dummy_value in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ kyc_timeout;
+ history_expiration;
+ history_fee;
+ kyc_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/offline_sig.ml b/.jjconflict-side-0/tools/offline_sig.ml
new file mode 100644
index 00000000..f89cca19
--- /dev/null
+++ b/.jjconflict-side-0/tools/offline_sig.ml
@@ -0,0 +1,147 @@
+open Crypto
+open Api
+
+let verify_future_keys_response =
+ 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 open Syntax in
+ 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 mk_future_keys =
+ 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 }
diff --git a/.jjconflict-side-1/.gitignore b/.jjconflict-side-1/.gitignore
new file mode 100644
index 00000000..dbd4866f
--- /dev/null
+++ b/.jjconflict-side-1/.gitignore
@@ -0,0 +1,3 @@
+_build
+data/secmod/*
+!data/secmod/.gitkeep
diff --git a/.jjconflict-side-1/.ocamlformat b/.jjconflict-side-1/.ocamlformat
new file mode 100644
index 00000000..43b12fc0
--- /dev/null
+++ b/.jjconflict-side-1/.ocamlformat
@@ -0,0 +1,15 @@
+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
new file mode 100644
index 00000000..be3f7b28
--- /dev/null
+++ b/.jjconflict-side-1/LICENSE
@@ -0,0 +1,661 @@
+ 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/data/assets/default.config b/.jjconflict-side-1/data/assets/default.config
new file mode 100644
index 00000000..a6c89c52
--- /dev/null
+++ b/.jjconflict-side-1/data/assets/default.config
@@ -0,0 +1,74 @@
+[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/data/assets/privacy/en/0.md b/.jjconflict-side-1/data/assets/privacy/en/0.md
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-1/data/assets/privacy/en/0.md
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-1/data/assets/privacy/en/0.txt b/.jjconflict-side-1/data/assets/privacy/en/0.txt
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-1/data/assets/privacy/en/0.txt
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-1/data/assets/terms/en/0.md b/.jjconflict-side-1/data/assets/terms/en/0.md
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-1/data/assets/terms/en/0.md
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-1/data/assets/terms/en/0.txt b/.jjconflict-side-1/data/assets/terms/en/0.txt
new file mode 100644
index 00000000..419e12ef
--- /dev/null
+++ b/.jjconflict-side-1/data/assets/terms/en/0.txt
@@ -0,0 +1 @@
+# TODO dummy ToS
diff --git a/.jjconflict-side-1/data/auditor_private_key b/.jjconflict-side-1/data/auditor_private_key
new file mode 100644
index 00000000..82aad694
--- /dev/null
+++ b/.jjconflict-side-1/data/auditor_private_key
@@ -0,0 +1 @@
+Iî÷q¸àwÇ´Y—›gbÙ'R+5µ™â°ƒˆyë>
\ No newline at end of file
diff --git a/.jjconflict-side-1/data/auditor_public_key b/.jjconflict-side-1/data/auditor_public_key
new file mode 100644
index 00000000..4b97fccf
--- /dev/null
+++ b/.jjconflict-side-1/data/auditor_public_key
@@ -0,0 +1 @@
+A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0
diff --git a/.jjconflict-side-1/data/master_offline_private_key b/.jjconflict-side-1/data/master_offline_private_key
new file mode 100644
index 00000000..739df007
Binary files /dev/null and b/.jjconflict-side-1/data/master_offline_private_key differ
diff --git a/.jjconflict-side-1/data/secmod/.gitkeep b/.jjconflict-side-1/data/secmod/.gitkeep
new file mode 100644
index 00000000..e69de29b
diff --git a/.jjconflict-side-1/dune-project b/.jjconflict-side-1/dune-project
new file mode 100644
index 00000000..5bd4e1f1
--- /dev/null
+++ b/.jjconflict-side-1/dune-project
@@ -0,0 +1,46 @@
+(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
+ zarith
+ mirage-crypto
+ digestif
+ duration
+ jsont
+ cohttp
+ ptime
+ logs
+ (ocamlformat :with-dev-setup)
+ ))
diff --git a/.jjconflict-side-1/include/dune b/.jjconflict-side-1/include/dune
new file mode 100644
index 00000000..3418869c
--- /dev/null
+++ b/.jjconflict-side-1/include/dune
@@ -0,0 +1,5 @@
+(library
+ (name include)
+ ; (wrapped false)
+ (modules taler_signatures)
+ (libraries))
diff --git a/.jjconflict-side-1/include/taler_signatures.ml b/.jjconflict-side-1/include/taler_signatures.ml
new file mode 100644
index 00000000..d9211977
--- /dev/null
+++ b/.jjconflict-side-1/include/taler_signatures.ml
@@ -0,0 +1,78 @@
+(* This file was generated by using data and/or code from the GNU Taler project,
+ under the AGPL-v3 licence.
+ Do not edit it. *)
+
+let master_aml_key : int32 = 1017_l
+let master_drain_profit : int32 = 1018_l
+let master_partner_details : int32 = 1019_l
+let master_signing_key_revoked : int32 = 1020_l
+let master_add_wire : int32 = 1021_l
+let master_global_fees : int32 = 1022_l
+let master_del_wire : int32 = 1023_l
+let master_signing_key_validity : int32 = 1024_l
+let master_denomination_key_validity : int32 = 1025_l
+let master_add_auditor : int32 = 1026_l
+let master_del_auditor : int32 = 1027_l
+let master_wire_fees : int32 = 1028_l
+let master_denomination_key_revoked : int32 = 1029_l
+let master_wire_details : int32 = 1030_l
+let master_extension : int32 = 1031_l
+let exchange_reserve_status : int32 = 1032_l
+let exchange_confirm_deposit : int32 = 1033_l
+let exchange_confirm_melt : int32 = 1034_l
+let exchange_key_set : int32 = 1035_l
+let exchange_confirm_wire : int32 = 1036_l
+let exchange_confirm_wire_deposit : int32 = 1037_l
+let exchange_confirm_refund : int32 = 1038_l
+let exchange_confirm_recoup : int32 = 1039_l
+let exchange_reserve_closed : int32 = 1040_l
+let exchange_confirm_recoup_refresh : int32 = 1041_l
+let exchange_affirm_denom_unknown : int32 = 1042_l
+let exchange_affirm_denom_expired : int32 = 1043_l
+let exchange_confirm_purse_creation : int32 = 1045_l
+let exchange_confirm_purse_merged : int32 = 1046_l
+let exchange_purse_status : int32 = 1047_l
+let exchange_reserve_attest_details : int32 = 1048_l
+let exchange_confirm_purse_refund : int32 = 1049_l
+let exchange_confirm_withdraw : int32 = 1050_l
+let auditor_exchange_keys : int32 = 1064_l
+let merchant_contract : int32 = 1101_l
+let merchant_refund : int32 = 1102_l
+let merchant_track_transaction : int32 = 1103_l
+let merchant_payment_ok : int32 = 1104_l
+let merchant_wire_details : int32 = 1107_l
+let merchant_token_issue : int32 = 1108_l
+let wallet_reserve_withdraw : int32 = 1200_l
+let wallet_coin_deposit : int32 = 1201_l
+let wallet_coin_melt : int32 = 1202_l
+let wallet_coin_recoup : int32 = 1203_l
+let wallet_coin_link : int32 = 1204_l
+let wallet_account_setup : int32 = 1205_l
+let wallet_coin_recoup_refresh : int32 = 1206_l
+let wallet_age_attestation : int32 = 1207_l
+let wallet_reserve_history : int32 = 1208_l
+let wallet_coin_history : int32 = 1209_l
+let wallet_purse_create : int32 = 1210_l
+let wallet_purse_deposit : int32 = 1211_l
+let wallet_purse_status : int32 = 1212_l
+let wallet_purse_merge : int32 = 1213_l
+let wallet_account_merge : int32 = 1214_l
+let wallet_reserve_close : int32 = 1215_l
+let wallet_purse_econtract : int32 = 1216_l
+let wallet_reserve_open : int32 = 1217_l
+let wallet_reserve_open_deposit : int32 = 1218_l
+let wallet_reserve_attest_details : int32 = 1219_l
+let wallet_purse_delete : int32 = 1220_l
+let wallet_reserve_age_withdraw : int32 = 1221_l
+let wallet_token_use : int32 = 1222_l
+let mailbox_messages_delete : int32 = 1223_l
+let sm_rsa_denomination_key : int32 = 1250_l
+let sm_signing_key : int32 = 1251_l
+let sm_cs_denomination_key : int32 = 1252_l
+let client_test_eddsa : int32 = 1302_l
+let exchange_test_eddsa : int32 = 1303_l
+let aml_decision : int32 = 1350_l
+let aml_query : int32 = 1351_l
+let kyc_auth : int32 = 1360_l
+let anastasis_policy_upload : int32 = 1400_l
+let sync_backup_upload : int32 = 1450_l
diff --git a/.jjconflict-side-1/mte.opam b/.jjconflict-side-1/mte.opam
new file mode 100644
index 00000000..8bdbc121
--- /dev/null
+++ b/.jjconflict-side-1/mte.opam
@@ -0,0 +1,49 @@
+# 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"
+ "zarith"
+ "mirage-crypto"
+ "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
new file mode 100644
index 00000000..65fde44d
--- /dev/null
+++ b/.jjconflict-side-1/src/amount.ml
@@ -0,0 +1,121 @@
+(* TODO
+ have safe amount arithmetic
+ make type private
+ redefine an Amount module with currency enforced to be Config.currency? *)
+(* Amounts of currency, serialized as `:.`
+ Fixed-precision numbers with 8 decimal places.
+ - must be at most 11 characters long
+ only consist of ASCII letters (a-zA-Z).
+ - integer part of may be at most 2^52.
+ - fractional part of may contain at most 8 decimal digits.
+
+ Prefixed with '+' or '-' in certain contexts.
+ When no sign is present, the amount is assumed to be positive. *)
+type sign =
+ | Sign_plus
+ | Sign_minus
+
+type t = {
+ sign: sign option;
+ currency: string;
+ value: Int64.t;
+ fraction: Int32.t;
+}
+
+let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
+let check_not msg = function false -> Ok () | true -> Error msg
+let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64
+let fraction_upper_bound = Int32.of_int 100_000_000
+
+let make ~sign ~currency ~value ~fraction =
+ let* () = check_not "value is negative" (value < Int64.zero) in
+ let* () = check_not "fraction is negative" (fraction < Int32.zero) in
+ let* () =
+ check_not "value is greater than 2^52" (value > value_upper_bound)
+ in
+ let* () =
+ check_not "fraction has more than 8 decimal digits"
+ (fraction >= fraction_upper_bound)
+ in
+ Ok { sign; currency; value; fraction }
+
+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 } ->
+ pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction
+
+let to_string = Fmt.str "%a" pp
+
+let of_string =
+ let open Angstrom in
+ let parse_sign =
+ choice
+ [
+ char '+' *> return (Some Sign_plus);
+ char '-' *> return (Some Sign_minus);
+ return None;
+ ]
+ in
+ let parse_currency =
+ (* TODO currency string constraint/format *)
+ take_while1 (function
+ | 'a' .. 'z' | 'A' .. 'Z' -> true
+ | _ -> false)
+ in
+ let parse_int64 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int64.of_string_opt
+ >>= function
+ | None -> fail "invalid integer"
+ | Some n -> return n
+ in
+ let parse_int32 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int32.of_string_opt
+ >>= function
+ | None -> fail "invalid integer"
+ | Some n -> return n
+ in
+ let parse_t =
+ lift4
+ (fun sign currency value fraction ->
+ make ~sign ~currency ~value ~fraction)
+ parse_sign parse_currency
+ (char ':' *> parse_int64)
+ (char '.' *> parse_int32)
+ in
+ fun s -> parse_string ~consume:Consume.All parse_t s |> Result.join
+
+let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
+let currency_len = 12
+
+let pad_currency s =
+ let len = String.length s in
+ assert (len <= 11);
+ let b = Bytes.make 12 '\x00' in
+ Bytes.blit_string s 0 b 0 len;
+ Bytes.to_string b
+
+let bin =
+ let open Bin in
+ record (fun _value _fraction _currency ->
+ (* no need to decode amount? *)
+ assert false)
+ |+ field neint64 (fun t -> t.value)
+ |+ field neint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency t.currency)
+ |> sealr
+
+let bin_nbo =
+ let open Bin in
+ record (fun _value _fraction _currency -> assert false)
+ |+ field beint64 (fun t -> t.value)
+ |+ field beint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency t.currency)
+ |> sealr
+
+let dummy_value = "DUMMY:0.0" |> of_string |> Result.get_ok
diff --git a/.jjconflict-side-1/src/amount.mli b/.jjconflict-side-1/src/amount.mli
new file mode 100644
index 00000000..920bed18
--- /dev/null
+++ b/.jjconflict-side-1/src/amount.mli
@@ -0,0 +1,34 @@
+(* TODO
+ ? have a currency agnostic amount_lib.ml and specialize amount.ml to Config.currency *)
+
+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 currency_len : int
+val jsont : t Jsont.t
+
+(* only for encoding *)
+val bin : t Bin.t
+val bin_nbo : t Bin.t
+
+(* TODO
+ dummy value to use as placeholder for WIP *)
+val dummy_value : t
diff --git a/.jjconflict-side-1/src/api.ml b/.jjconflict-side-1/src/api.ml
new file mode 100644
index 00000000..519cfb38
--- /dev/null
+++ b/.jjconflict-side-1/src/api.ml
@@ -0,0 +1,1347 @@
+(* TODO
+ ppx?
+ normalized JSON-object
+ for signature of ExchangeKeysResponse.exetensions field
+ option: correct use opt_mem or Jsont.option
+ better types:
+ - payto_uri
+ - uri *)
+
+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: const string
+ name: "taler-exchange";*)
+ implementation: string option;
+ currency: string;
+ shopping_url: string option;
+ open_banking_gateway: string option;
+ currency_specification: CurrencySpecification.t;
+ supported_kyc_requirements: string list;
+ aml_spa_dialect: string option;
+ }
+
+ let jsont =
+ let make version implementation currency shopping_url open_banking_gateway
+ currency_specification supported_kyc_requirements aml_spa_dialect =
+ {
+ version;
+ implementation;
+ currency;
+ shopping_url;
+ open_banking_gateway;
+ currency_specification;
+ supported_kyc_requirements;
+ aml_spa_dialect;
+ }
+ in
+ let version v = v.version 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 supported_kyc_requirements v = v.supported_kyc_requirements in
+ let aml_spa_dialect v = v.aml_spa_dialect in
+ map ~kind:"ExchangeVersionResponse" make
+ |> mem "version" Jsont.string ~enc:version
+ |> 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 "supported_kyc_requirements" (Jsont.list Jsont.string)
+ ~enc:supported_kyc_requirements
+ |> mem "aml_spa_dialect" (Jsont.option Jsont.string) ~enc:aml_spa_dialect
+ |> finish
+end
+
+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;
+ (* TODO monotonic time
+ something about using monotonic system time here! *)
+ 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;
+ (* TODO monotonic time *)
+ 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;
+ (* TODO monotonic time *)
+ 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;
+ (* TODO monotonic time *)
+ 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;
+ }
+
+ 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
new file mode 100644
index 00000000..9d6c8088
--- /dev/null
+++ b/.jjconflict-side-1/src/assets.ml
@@ -0,0 +1,150 @@
+(* TODO clean up *)
+
+(* docs: https://docs.taler.net/manpages/taler-exchange.conf.5.html
+ https://docs.taler.net/design-documents/003-tos-rendering.html *)
+
+(* hardcoded config just for static assets *)
+let default_lang = "en"
+let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
+
+(* todo: Taler documentation markdown mimetype should be the prefered one, and be
+ supported, according to DD we take text/plain as default instead for now *)
+let default_mimetype = ("text", "plain")
+let default_extension = ".txt"
+let terms_legal_version = "1"
+let privacy_legal_version = "1"
+
+module Mimetype = struct
+ let mimetype_extension_assoc =
+ [
+ (("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 mimetype_l, _ = List.split mimetype_extension_assoc
+
+ let of_cohttp_media = function
+ | Cohttp.Accept.MediaType (m, m_sub) ->
+ List.find_opt (( = ) (m, m_sub)) mimetype_l
+ | AnyMediaSubtype m ->
+ List.find_opt (fun (m', _) -> String.equal m m') mimetype_l
+ | AnyMedia -> Some default_mimetype
+
+ let to_extension (m, m_sub) =
+ assert (m <> "*");
+ assert (m_sub <> "*");
+ List.assoc_opt (m, m_sub) mimetype_extension_assoc
+
+ let of_extension ext =
+ List.find_map
+ (fun (mime, ext') ->
+ match String.equal ext ext' with false -> None | true -> Some mime)
+ mimetype_extension_assoc
+
+ let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
+end
+
+(* TODO config *)
+type t =
+ | Terms
+ | Privacy
+
+let etag k =
+ Result.get_ok
+ @@ Headers_lib.Etag.of_crockford32
+ @@ match k with Terms -> "0" | Privacy -> "0"
+
+let legal_version = function
+ | Terms -> terms_legal_version
+ | Privacy -> privacy_legal_version
+
+let base_dir = function
+ | Terms -> Fpath.v "terms"
+ | Privacy -> Fpath.v "privacy"
+
+(* does some checks on assets/ folder content and infer the set of supported languages and mimetype *)
+let supported_lang_arr, supported_ext_arr =
+ let open Syntax in
+ let path_l =
+ Assets_crunch.file_list |> list_map Fpath.of_string |> function
+ | Error (`Msg e) -> Fmt.failwith "%s" e
+ | Ok x -> x
+ in
+ let aux t =
+ let prefix = base_dir t in
+ let path_l = path_l |> List.filter_map (Fpath.rem_prefix prefix) in
+ let ext_l =
+ path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
+ in
+ let lang_l =
+ path_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 path))
+ |> List.sort_uniq String.compare
+ in
+ let () =
+ 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 default_lang lang_l then
+ Fmt.failwith "default language `%s` files not found" 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"
+ in
+ (lang_l, ext_l)
+ in
+ let lang_l, ext_l = aux Terms in
+ let lang_l', ext_l' = aux Privacy in
+ let () =
+ if
+ not
+ @@ (List.equal String.equal lang_l lang_l'
+ && List.equal String.equal ext_l ext_l')
+ then
+ Fmt.failwith
+ "invalid folder structure, /terms and /privacy must support the same \
+ set of languages and mimetypes";
+ ()
+ in
+ (Array.of_list lang_l, Array.of_list ext_l)
+
+let supported_mimetype_arr =
+ Array.map Mimetype.of_extension supported_ext_arr |> Array.map Option.get
+
+let is_supported_lang lang = Array.mem lang supported_lang_arr
+let is_supported_ext ext = Array.mem ext supported_ext_arr
+let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr
+
+(* ! lang and mime must be supported *)
+let get_content ~lang ~mime t =
+ let etag = Headers_lib.Etag.to_raw_string (etag t) in
+ let ext =
+ match Mimetype.to_extension mime with
+ | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime)
+ | Some ext -> ext
+ in
+ let path = Fpath.to_string Fpath.((base_dir t / lang / etag) + 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
new file mode 100644
index 00000000..6bd06400
--- /dev/null
+++ b/.jjconflict-side-1/src/b32.ml
@@ -0,0 +1,38 @@
+(* 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
new file mode 100644
index 00000000..9be285c0
--- /dev/null
+++ b/.jjconflict-side-1/src/config.ml
@@ -0,0 +1,200 @@
+open Parse_config
+
+let config_data =
+ let path = Fpath.to_string (Fpath.v "default.config") in
+ match Assets_crunch.read path with
+ | None -> fail "static file not found: `%s`" path
+ | Some data ->
+ let v = Parse_data.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"
+ let privacy_etag = get "privacy_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_res;
+ }
+
+ 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
new file mode 100644
index 00000000..bf437fce
--- /dev/null
+++ b/.jjconflict-side-1/src/crypto.ml
@@ -0,0 +1,300 @@
+open Syntax
+
+module Binary_format_rsa = struct
+ (* TODO tests:
+ - need to strip leading zeros?
+ - endianess ok? *)
+ (* 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 rev_string len s = String.init len (fun i -> s.[len - 1 - i])
+
+ (* we reverse bytes because Z.of_bits reads bytes in little endian *)
+ let z_of_bits_be src pos len =
+ String.sub src pos len |> rev_string len |> Z.of_bits
+
+ let z_to_bits_be z =
+ let bits = Z.to_bits z in
+ rev_string (String.length bits) bits
+
+ let z_array_to_octets (arr : Z.t array) =
+ let nb = Array.length arr in
+ let bits_arr = Array.map z_to_bits_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 check = function
+ | false -> Error "rsa of_octets error, invalid data"
+ | true -> Ok ()
+
+ let z_array_of_octets ~nb s =
+ let s_len = String.length s in
+ let* () = check (s_len > 2 * nb) in
+ 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* () =
+ let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
+ check (s_len = len)
+ in
+ let z_arr =
+ Array.init nb (fun i ->
+ let len = len_arr.(i) in
+ let z = z_of_bits_be s !pos len 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
+
+ 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
+
+(* TODO key format
+ - check what is the exact format in GNUNET
+ - endianess issue? *)
+module EddsaPublicKey = 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 = 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
+ (* TODO key format
+ endianess issue? *)
+ (* 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 "signature verification failure: invalid signature"
+ | true -> Ok ()
+
+ let to_octets t = t
+
+ let of_octets v =
+ match String.length v = 64 with
+ | false ->
+ Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
+ | true -> Ok 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 check_size t =
+ match String.length t = 64 with
+ | false -> Error "EddsaSignature: invalid string length"
+ | true -> Ok ()
+
+ let jsont =
+ let of_b32 s =
+ let* t = B32.decode s in
+ let+ () = check_size t in
+ 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 sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t
+ val jsont : t Jsont.t
+end = struct
+ type t = string
+
+ (* TODO rsa sign *)
+ let sign ~key s =
+ Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s
+
+ 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 denomination_hash = Hash.DenominationHash.t
diff --git a/.jjconflict-side-1/src/data_file.ml b/.jjconflict-side-1/src/data_file.ml
new file mode 100644
index 00000000..9fa34674
--- /dev/null
+++ b/.jjconflict-side-1/src/data_file.ml
@@ -0,0 +1,35 @@
+open Bos.OS
+open Syntax
+open Crypto
+
+let read fname =
+ let* b = File.exists fname |> Syntax.unwrap_err_msg in
+ match b with
+ | false -> Ok None
+ | true ->
+ let+ content = File.read fname |> Syntax.unwrap_err_msg in
+ Some content
+
+let write_eddsa fname priv =
+ EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let write_rsa fname priv =
+ RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let read_eddsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ EddsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
+
+let read_rsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ RsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
diff --git a/.jjconflict-side-1/src/denom_data.ml b/.jjconflict-side-1/src/denom_data.ml
new file mode 100644
index 00000000..7d94367d
--- /dev/null
+++ b/.jjconflict-side-1/src/denom_data.ml
@@ -0,0 +1,18 @@
+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: denomination_hash;
+ master_sig: Signatures.DenominationKeyValidity.t option;
+ revoked_sig: Signatures.MasterDenominationKeyRevocation.t option;
+}
diff --git a/.jjconflict-side-1/src/devices.ml b/.jjconflict-side-1/src/devices.ml
new file mode 100644
index 00000000..7da26428
--- /dev/null
+++ b/.jjconflict-side-1/src/devices.ml
@@ -0,0 +1,26 @@
+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 secmod =
+ let finally _key = () in
+ Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
+ @@ fun (module Conn : Pg.CONN) (_env : env) ->
+ let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in
+ sm
diff --git a/.jjconflict-side-1/src/dune b/.jjconflict-side-1/src/dune
new file mode 100644
index 00000000..2a1a266a
--- /dev/null
+++ b/.jjconflict-side-1/src/dune
@@ -0,0 +1,45 @@
+(executable
+ (public_name mte)
+ (name mte)
+ (modules mte)
+ (libraries mte))
+
+(library
+ (name mte)
+ (wrapped false)
+ (modules :standard \ mte b32)
+ (libraries
+ b32
+ include
+ ;
+ caqti
+ caqti-miou
+ caqti-miou.unix
+ caqti-driver-pgx
+ bin
+ mirage-crypto
+ 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 ../data/assets/))
+ (action
+ (with-stdout-to
+ %{null}
+ (run ocaml-crunch -m plain ../data/assets -o %{target}))))
diff --git a/.jjconflict-side-1/src/hash.ml b/.jjconflict-side-1/src/hash.ml
new file mode 100644
index 00000000..ca32519f
--- /dev/null
+++ b/.jjconflict-side-1/src/hash.ml
@@ -0,0 +1,108 @@
+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 String.length s = 32 with
+ | false -> Fmt.failwith "Hash.of_octets failure: data is not 32 bytes"
+ | true -> SHA256.of_raw_string s
+
+ 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 String.length s = 64 with
+ | false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes"
+ | true -> SHA512.of_raw_string s
+
+ let to_octets v =
+ let s = SHA512.to_raw_string v in
+ match String.length s = 64 with
+ | false -> Fmt.failwith "Hash.to_octets failure: data is not 64 bytes"
+ | true -> s
+
+ 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
new file mode 100644
index 00000000..f41fc976
--- /dev/null
+++ b/.jjconflict-side-1/src/headers.ml
@@ -0,0 +1,61 @@
+let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item
+
+let accept_header_value =
+ let s =
+ Fmt.str "%a"
+ (pp_array Assets.Mimetype.pp_mime)
+ Assets.supported_mimetype_arr
+ in
+ s
+
+let avail_languages_header_value =
+ let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
+ s
+
+let select_mimetype headers =
+ let opt = Vif.Headers.get headers "accept" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept: %s" s);
+ Cohttp.Accept.media_ranges opt
+ |> Cohttp.Accept.qsort
+ |> List.filter_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
+ |> List.find_opt Assets.is_supported_mimetype
+
+let select_language headers =
+ let opt = Vif.Headers.get headers "accept-language" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept-language: %s" s);
+ Cohttp.Accept.languages opt
+ |> Cohttp.Accept.qsort
+ |> List.map (fun (_q, lang) -> lang)
+ |> List.map (function
+ | Cohttp.Accept.AnyLanguage -> Assets.default_lang
+ | Language language_range -> (
+ (* ignore language subtags (e.g. "en-US" -> "en") *)
+ match language_range with
+ | [] -> assert false
+ | primary_tag :: _ -> primary_tag))
+ |> List.find_opt Assets.is_supported_lang
+ |> Option.value ~default:Assets.default_lang
+
+let select_encoding headers =
+ let opt = Vif.Headers.get headers "accept-encoding" in
+ Logs.err (fun m ->
+ let s = Option.value ~default:"none" opt in
+ m "Header accept-encoding: %s" s);
+ Cohttp.Accept.encodings opt
+ |> Cohttp.Accept.qsort
+ |> List.map snd
+ |> List.filter_map (function
+ | Cohttp.Accept.Identity -> Some `Identity
+ | Deflate -> Some `DEFLATE
+ | Gzip -> Some `Gzip
+ | AnyEncoding -> Some Assets.default_encoding
+ | Encoding _ | Compress -> (* unsupported *) None)
+ |> function
+ | [] -> assert false
+ | `Identity :: _ -> None
+ | `DEFLATE :: _ -> Some `DEFLATE
+ | `Gzip :: _ -> Some `Gzip
diff --git a/.jjconflict-side-1/src/headers_lib.ml b/.jjconflict-side-1/src/headers_lib.ml
new file mode 100644
index 00000000..b26f5da1
--- /dev/null
+++ b/.jjconflict-side-1/src/headers_lib.ml
@@ -0,0 +1,86 @@
+(* independent library for headers fields value *)
+
+(* TODO - test - can still bypass this module and directly set Etag header, but
+ its fine *)
+module Etag : sig
+ (* module to parse etags header fields used by If-Match and If-None-Match
+ headers
+
+ https://httpwg.org/specs/rfc9110.html#field.etag *)
+ type t
+ type header_value
+
+ val parse : string -> (header_value, string) result
+ val of_crockford32 : string -> (t, string) result
+ val to_raw_string : t -> string
+ val to_field_value : t -> string
+ val evaluate : t -> header_value -> bool
+end = struct
+ (* raw etag *)
+ type t = string
+
+ (* type for the value of header field *)
+ type header_etag_item = {
+ weak: bool;
+ value: string;
+ }
+
+ type header_value =
+ | Any_etag
+ | Etag_list of header_etag_item list
+
+ let pp_header_etag_item ppf { weak; value } =
+ if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value
+
+ let to_raw_string t = t
+
+ let to_field_value t =
+ (* always weak comparison for If-None-Match header *)
+ let v = { weak= true; value= t } in
+ Fmt.str "%a" pp_header_etag_item v
+
+ let is_valid_char c =
+ let n = Char.code c in
+ (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+
+ let has_valid_charset s = String.for_all is_valid_char s
+
+ let of_crockford32 s =
+ match has_valid_charset s with
+ | false -> Error "invalid etag"
+ | true -> Ok s
+
+ let parse =
+ let open Angstrom in
+ let ws = skip_while (function ' ' -> true | _ -> false) in
+ let quoted_string =
+ char '"' *> take_till (fun c -> c = '"') <* char '"' >>= fun s ->
+ if String.for_all is_valid_char s then return s
+ else fail "found illegal char"
+ in
+ let item =
+ ws
+ *> lift2
+ (fun weak value -> { weak; value })
+ (option false (string "W/" *> return true))
+ quoted_string
+ <* ws
+ in
+ let comma = ws *> char ',' *> ws in
+ let list_of_items = sep_by1 comma item in
+ let parse_header_value =
+ char '*' *> return Any_etag
+ <|> (list_of_items >>| fun items -> Etag_list items)
+ <* end_of_input
+ in
+ fun s ->
+ match parse_string ~consume:Consume.All parse_header_value s with
+ | Error e -> Fmt.error "invalid etag: %s" e
+ | Ok v -> Ok v
+
+ let evaluate t header_value =
+ match header_value with
+ | Any_etag -> false
+ | Etag_list l ->
+ not @@ List.exists (fun { weak= _; value } -> String.equal t value) l
+end
diff --git a/.jjconflict-side-1/src/http_keys.ml b/.jjconflict-side-1/src/http_keys.ml
new file mode 100644
index 00000000..eaea4776
--- /dev/null
+++ b/.jjconflict-side-1/src/http_keys.ml
@@ -0,0 +1,265 @@
+open Syntax
+open Api
+module String_map = Stdlib.Map.Make (Stdlib.String)
+
+(* TODO
+ for now we only have one item in each "denom group"
+ change this once we have denom/signkey rotation *)
+let denomgroup_of_denomdata
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask= _;
+ h_pub= _;
+ master_sig;
+ revoked_sig= _;
+ } =
+ let master_sig = match master_sig with None -> assert false | Some v -> v in
+ let denoms =
+ [
+ RsaDenom.
+ {
+ rsa_pub= pub;
+ master_sig;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ lost= None;
+ };
+ ]
+ in
+ DenomGroup.Rsa
+ RsaDenomGroup.
+ { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
+
+let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
+ let version = Api.protocol_version in
+ let base_url = Config.base_url in
+ let currency = Config.currency in
+ let shopping_url = Config.shopping_url in
+ let open_banking_gateway = Config.open_banking_gateway_url in
+ let bank_compliance_language = Config.bank_compliance_language in
+ let currency_specification =
+ let v = Config.Currency.v in
+ let alt_unit_names =
+ Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+ in
+ CurrencySpecification.
+ {
+ name= v.name;
+ num_fractional_input_digits= v.fractional_input_digits;
+ num_fractional_normal_digits= v.fractional_normal_digits;
+ num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits;
+ alt_unit_names;
+ common_amounts= [];
+ }
+ in
+ let tiny_amount = Config.tiny_amount in
+ let stefan_abs = Config.stefan_abs in
+ let stefan_log = Config.stefan_log in
+ let stefan_lin = Config.stefan_lin in
+ (* todo asset_type
+ Type of the asset. "fiat", "crypto", "regional" or "stock". *)
+ let asset_type = "xxx" in
+ let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in
+ let* wire_fees =
+ (* todo
+ where does wire_methods comes from? *)
+ let wire_method = "xxx" in
+ let+ wire_fees =
+ Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti
+ in
+ String_map.singleton wire_method wire_fees
+ in
+ let wads =
+ (* TODO wads *)
+ []
+ in
+ let rewards_allowed = false in
+ let kyc_enabled = false in
+ let disable_direct_deposit = (* todo *) false in
+ let master_public_key = Config.master_public_key in
+ let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in
+ (* todo *)
+ let wallet_balance_limit_without_kyc = None in
+ let hard_limits = [] in
+ let zero_limits = [] in
+ let denom_data_l =
+ (* TODO sm-db *)
+ (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
+ Sm.get_denoms_data ()
+ in
+ let denom_data_l =
+ (* reverse chronological order *)
+ List.sort
+ (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start)
+ denom_data_l
+ in
+ let list_issue_date =
+ match denom_data_l with
+ | [] -> Time.Timestamp.never
+ | v :: _ -> v.Denom_data.stamp_start
+ in
+ let denominations =
+ let open Denom_data in
+ (* if `?last_issue_date` query param does not exactly match the `stamp_start`
+ of one of the denomination keys, all keys are returned *)
+ let l =
+ match last_issue_date with
+ | None -> denom_data_l
+ | Some last_issue_date -> (
+ match
+ List.find_opt
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date = 0)
+ denom_data_l
+ with
+ | None -> denom_data_l
+ | Some _ ->
+ List.filter
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
+ denom_data_l)
+ in
+ List.map denomgroup_of_denomdata l
+ in
+
+ let signkeys =
+ (* TODO sm-db
+ use database signkey data / verify secmod and database are in sync *)
+ (*
+ let now = Ptime_clock.now () |> Option.some in
+ let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
+ let signkey_data_l = Sm.get_signkeys_data () in
+ let signkey_data_l =
+ List.sort
+ (fun a b ->
+ let open Signkey_data in
+ Stdlib.compare b.stamp_start a.stamp_start)
+ signkey_data_l
+ in
+ List.filter_map
+ (fun Signkey_data.
+ {
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig;
+ revoked_sig= _;
+ } ->
+ match master_sig with
+ | None -> None
+ | Some master_sig ->
+ Some
+ SignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; master_sig })
+ signkey_data_l
+ in
+
+ let exchange_pub =
+ (* the eddsa pub key used to sign exchange_sig *)
+ match signkeys with
+ | [] -> Fmt.failwith "exchange has no active signkey"
+ | v :: _ -> v.SignKey.key
+ in
+ let exchange_sig =
+ (* Compact EdDSA signature (binary-only) over the
+ contatentation of all of the master_sigs (in reverse
+ chronological order by group) in the arrays under "denominations". *)
+ let hc =
+ denom_data_l
+ |> List.filter_map (fun v -> v.Denom_data.master_sig)
+ |> List.map Signatures.DenominationKeyValidity.to_octets
+ |> String.concat ""
+ |> Hash.H64.hash
+ in
+ let open Signatures.ExchangeKeySet in
+ sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc }
+ in
+
+ let recoup = (* TODO /recoup *) [] in
+ let* global_fees =
+ (* WIP DEBUG
+ Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti
+ *)
+ Ok []
+ 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
+
+(* TODO query param ?last_issue_date *)
+let f req server _env =
+ Logs.info (fun m -> m "GET /keys");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* last_issue_date =
+ match Vif.Queries.get req "last_issue_date" with
+ | [] -> Ok None
+ | v :: _ -> (
+ match int_of_string_opt v with
+ | None ->
+ Error
+ "invalid `?last_issue_date` query param, int_of_string failure"
+ | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n))))
+ in
+ let* v = mk_keys ~db_conn sm ~last_issue_date in
+ let s = Api.encode_exn jsont v in
+ Ok s
+ in
+ Respond_util.respond_with_res res req
diff --git a/.jjconflict-side-1/src/http_management.ml b/.jjconflict-side-1/src/http_management.ml
new file mode 100644
index 00000000..4b0aa352
--- /dev/null
+++ b/.jjconflict-side-1/src/http_management.ml
@@ -0,0 +1,750 @@
+open Syntax
+open Api
+open Hash
+
+module Keys_get = struct
+ let mk_future_denom (module Sm : Secmod.S) ~section_name
+ ({
+ 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= _;
+ } :
+ Denom_data.t) =
+ let denom_pub =
+ DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= 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:Sm.sign_with_sm_key
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+ in
+ FutureDenom.
+ {
+ section_name;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig;
+ }
+
+ let mk_future_signkey (module Sm : Secmod.S)
+ ({
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig= _;
+ revoked_sig= _;
+ } :
+ Signkey_data.t) =
+ 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:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration }
+ in
+ FutureSignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+
+ let mk_future_keys_response (module Sm : Secmod.S) =
+ let future_signkeys =
+ Sm.get_signkeys_data ()
+ |> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig)
+ |> List.map (fun signkey -> mk_future_signkey (module Sm) signkey)
+ in
+ let future_denoms =
+ Sm.get_denoms_data ()
+ |> List.filter (fun k -> Option.is_none k.Denom_data.master_sig)
+ |> List.map (fun dn_data ->
+ let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in
+ match opt with
+ | None -> Fmt.failwith "section_name not found."
+ | Some section_name ->
+ mk_future_denom (module Sm) ~section_name dn_data)
+ in
+ let master_pub = Config.Exchange.master_public_key in
+ let denom_secmod_public_key = Sm.get_sm_key_pub () in
+ let signkey_secmod_public_key = Sm.get_sm_key_pub () 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_util.respond_with_res res req
+end
+
+module Keys_post = struct
+ let verify_denom_signature (module Sm : Secmod.S)
+ DenomSignature.{ h_denom_pub; master_sig } =
+ let* denom =
+ match Sm.find_denom_data h_denom_pub with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some denom -> Ok denom
+ in
+ let 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:Sm.verify_with_master_key master_sig r
+
+ let verify_signkey_signature (module Sm : Secmod.S)
+ SignKeySignature.{ key; master_sig } =
+ let* signkey =
+ match Sm.find_signkey_data key with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some signkey -> Ok signkey
+ in
+ let open Signatures.ExchangeSigningKeyValidity in
+ let r : r =
+ {
+ start= signkey.stamp_start;
+ expire= signkey.stamp_expire;
+ end_= signkey.stamp_end;
+ signkey_pub= signkey.pub;
+ }
+ in
+ verify_f ~f:Sm.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 ()
+
+ (* TODO move to test *)
+ let check_master_signatures_update ~db_conn (module Sm : Secmod.S) =
+ Sm.get_denoms_data ()
+ |> list_iter (fun denom ->
+ let error = Error "update_master_signatures sanity check failure" in
+ let* opt =
+ Pg.find_denom db_conn denom.Denom_data.h_pub |> unwrap_err_caqti
+ in
+ let* v = match opt with None -> error | Some v -> Ok v in
+ let check = function false -> error | true -> Ok () in
+ let* () =
+ check (Timestamp.compare v.stamp_start denom.stamp_start = 0)
+ in
+ let* () = check (v.value = denom.value) in
+ let* () = check (v.fee_refund = denom.fee_refund) in
+ let* () = check (v.age_mask = denom.age_mask) in
+ Ok ())
+
+ let do_ ~db_conn (module Sm : Secmod.S)
+ MasterSignatures.{ denom_sigs; signkey_sigs } =
+ let* () =
+ signkey_sigs
+ |> List.map (fun SignKeySignature.{ key; master_sig } ->
+ (key, master_sig))
+ |> Sm.add_signkey_master_signatures
+ in
+ let* () =
+ denom_sigs
+ |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
+ (h_denom_pub, master_sig))
+ |> Sm.add_denom_master_signatures
+ in
+ let* () = Sm.store () in
+ let* () = check_master_signatures_update ~db_conn (module Sm) 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_util.respond_with_res res req
+end
+
+module Denom_revoke = struct
+ let verify (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let open Signatures.MasterDenominationKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let* () = Sm.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_util.respond_with_res res req
+end
+
+module Signkey_revoke = struct
+ let verify (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let open Signatures.MasterSigningKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let* () = Sm.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_util.respond_with_res res req
+end
+
+module Auditors = struct
+ let verify (module Sm : Secmod.S)
+ AuditorSetupMessage.
+ {
+ auditor_url;
+ auditor_name= _;
+ auditor_pub;
+ master_sig;
+ validity_start;
+ } =
+ let open Signatures.MasterAddAuditor in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date= validity_start;
+ auditor_pub;
+ h_auditor_url= Hash.Cstring.H64.hash auditor_url;
+ }
+
+ (* TODO timestamps last_change +/- checks *)
+ (* todo: there is something about use of monotonic time
+ + protection against replay attack that I don't understand *)
+ 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_util.respond_with_res res req
+end
+
+module Auditors_disable = struct
+ let verify (module Sm : Secmod.S) auditor_pub
+ AuditorTeardownMessage.{ master_sig; validity_end } =
+ let open Signatures.MasterDelAuditor in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module Wire_fee = struct
+ let verify (module Sm : Secmod.S)
+ WireFeeSetupMessage.
+ {
+ wire_method;
+ master_sig_wire;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ } =
+ let open Signatures.MasterWireFee in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module Global_fees = struct
+ let verify (module Sm : Secmod.S)
+ GlobalFees.
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ } =
+ (* TODO KYC
+ what is kyc_timeout, kyc_fee ? *)
+ let kyc_timeout = Time.Relative.forever in
+ let kyc_fee = Amount.dummy_value in
+ (* * *)
+ let open Signatures.GlobalFees in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ kyc_timeout;
+ history_expiration;
+ history_fee;
+ kyc_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 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_util.respond_with_res res req
+end
+
+module Wire = struct
+ let verify (module Sm : Secmod.S)
+ WireSetupMessage.
+ {
+ payto_uri;
+ master_sig_wire;
+ master_sig_add;
+ validity_start;
+ bank_label= _;
+ priority= _;
+ } =
+ (* TODO wire *)
+ let conversion_url = "" in
+ let credit_restrictions = "" in
+ let debit_restrictions = "" in
+ let* () =
+ let open Signatures.MasterWireDetails in
+ verify_f ~f:Sm.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:Sm.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 ->
+ (* TODO wire *)
+ let last_change = Timestamp.of_ptime (Ptime_clock.now ()) in
+ let v =
+ 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 |> 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_util.respond_with_res res req
+end
+
+module Wire_disable = struct
+ let verify (module Sm : Secmod.S)
+ WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
+ let open Signatures.MasterDelWire in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module Drain = struct
+ let verify (module Sm : Secmod.S)
+ DrainProfitsMessage.
+ {
+ debit_account_section;
+ credit_payto_uri;
+ wtid;
+ master_sig;
+ date;
+ amount;
+ } =
+ let open Signatures.MasterDrainProfit in
+ verify_f ~f:Sm.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_util.respond_with_res res req
+end
+
+module AmlOfficer = struct
+ let verify (module Sm : Secmod.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:Sm.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_util.respond_with_res res req
+end
+
+module Partners = struct
+ let verify (module Sm : Secmod.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:Sm.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_util.respond_with_res res req
+end
diff --git a/.jjconflict-side-1/src/mte.ml b/.jjconflict-side-1/src/mte.ml
new file mode 100644
index 00000000..f98ee88f
--- /dev/null
+++ b/.jjconflict-side-1/src/mte.ml
@@ -0,0 +1,77 @@
+(* 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 tos =
+ let v s = rel / s in
+ [
+ get_ rel --> hello;
+ get_ (v "terms") --> Static.terms;
+ get_ (v "privacy") --> Static.privacy;
+ ]
+ in
+ let status_info = [ get_ (rel / "keys") --> Http_keys.f ] in
+ let management =
+ let open Http_management in
+ let v s = rel / "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.secmod ] 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
new file mode 100644
index 00000000..cd2c141a
--- /dev/null
+++ b/.jjconflict-side-1/src/parse_config.ml
@@ -0,0 +1,262 @@
+(* parse config file
+ 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 whitespace = skip_while is_whitespace
+
+module Parse_data = struct
+ type line =
+ | 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 take_till_end_of_line =
+ take_till is_eol >>= fun s -> return s <* end_of_line
+
+ let blank = whitespace <* end_of_line >>| fun () -> Blank
+
+ let comment =
+ whitespace *> (char '#' <|> char '%') *> take_till_end_of_line >>| fun s ->
+ Comment s
+
+ let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s
+
+ let item_value =
+ let unquoted_value =
+ take_while1 (fun c -> not (is_whitespace c || is_eol c))
+ in
+ let quoted_value =
+ char '"' *> take_till is_eol >>= fun s ->
+ match String.ends_with ~suffix:"\"" 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
+ (whitespace *> char '=' *> whitespace *> item_value)
+ <* end_of_line
+
+ let config = many (choice [ blank; 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 Pp_debug = struct
+ let pp_item ppf { key; value } =
+ let open Fmt in
+ match String.contains value '"' || String.contains value ' ' with
+ | false -> pf ppf "%s = %s" key value
+ | true -> pf ppf "%s = \"%s\"" key value
+
+ let pp_line ppf line =
+ let open Fmt in
+ let open Parse_data in
+ match line with
+ | Blank -> Fmt.nop ppf ()
+ | Comment s -> pf ppf "#%s" s
+ | Header s -> pf ppf "[%s]" s
+ | Item item -> pf ppf "%a" pp_item item
+
+ let _pp_lines ppf raw_line_l =
+ let open Fmt in
+ pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l
+
+ let pp_section ppf { header; items } =
+ let open Fmt in
+ pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items
+
+ let pp_config ppf l =
+ let open Fmt in
+ pf ppf "%a" (list ~sep:(any "\n") pp_section) l
+end
+[@@ocaml.warning "-32"]
+
+module Parse_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 = whitespace *> integer in
+ let dunit =
+ whitespace *> 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 ptime_span_of_int64 i =
+ match Ptime.Span.of_float_s (Int64.to_float i) with
+ | None ->
+ fail "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i
+ | Some ts -> ts
+
+ let to_time_span t =
+ let acc =
+ List.fold_left
+ (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
+ 0 t
+ in
+ let acc = Int64.of_int acc in
+ Time.Relative.of_s acc
+
+ 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_res = 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_res
+let duration s = Parse_duration.(s |> parse |> to_time_span)
+
+let ed25519 s =
+ s
+ |> B32.decode
+ |> unwrap_res
+ |> Mirage_crypto_ec.Ed25519.pub_of_octets
+ |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
+ |> unwrap_res
+
+(* 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
new file mode 100644
index 00000000..32428045
--- /dev/null
+++ b/.jjconflict-side-1/src/pg.ml
@@ -0,0 +1,374 @@
+(* TODO
+
+ check there is no issues with signed/unsigned integers
+
+ how to fix postgres/caqti tuple type?
+ try something with OID?
+ need to add boilerplate in each query for amounts
+
+ GNU Taler db-events?
+ it seems caqti/pgx does not support it
+
+ transaction
+
+ should check validity of signatures got from db, for /management at least
+
+ clean up caqti error type *)
+(* TODO time
+ fix comparison with timestamp footgun *)
+
+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.(denomination_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 denomination_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 denomination_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 denomination_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 =
+ (* TODO check syntax on this *)
+ 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
new file mode 100644
index 00000000..0a2e8f15
--- /dev/null
+++ b/.jjconflict-side-1/src/pg_type.ml
@@ -0,0 +1,377 @@
+(* this module defines caqti encoding/decodings *)
+open Caqti_type
+open Crypto
+open Api
+
+(* TODO
+ check that we use Caqti_type.octets for binary data *)
+
+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 denomination_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_data.
+ { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
+ ->
+ match master_sig with
+ | None -> Error "signkey_data master_sig is none"
+ | Some master_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= Some 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
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig;
+ revoked_sig;
+ }
+ ->
+ match master_sig with
+ | None -> Error "denom_data master_sig is none"
+ | Some master_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= Some master_sig;
+ revoked_sig;
+ })
+ (t12 rsa_pub amount time time time time amount amount amount amount int
+ (t3 denomination_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_util.ml b/.jjconflict-side-1/src/respond_util.ml
new file mode 100644
index 00000000..3c4faf5d
--- /dev/null
+++ b/.jjconflict-side-1/src/respond_util.ml
@@ -0,0 +1,22 @@
+let respond_with_plain_text_error ?status e req =
+ let open Vif.Response in
+ let open Syntax in
+ let status = Option.value ~default:`Bad_request status in
+ let* () = add ~field:"content-type" "text/plain; charset=utf-8" in
+ let* () = with_string req e in
+ respond status
+
+let respond_with_ok_json content req =
+ let open Vif.Response in
+ let open Syntax in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string req content in
+ respond `OK
+
+let respond_with_res res req =
+ match res with
+ | Error err ->
+ Logs.err (fun m -> m "%s." err);
+ let err = Fmt.str "%s@." err in
+ respond_with_plain_text_error err req
+ | Ok content -> respond_with_ok_json content req
diff --git a/.jjconflict-side-1/src/secmod.ml b/.jjconflict-side-1/src/secmod.ml
new file mode 100644
index 00000000..ed74310f
--- /dev/null
+++ b/.jjconflict-side-1/src/secmod.ml
@@ -0,0 +1,407 @@
+module type S = sig
+ open Crypto
+
+ 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
+
+ (* TODO query database instead? *)
+ val get_sm_key_pub : unit -> eddsa_pub
+ val get_signkeys_data : unit -> Signkey_data.t list
+ val get_denoms_data : unit -> Denom_data.t list
+ val find_signkey_data : eddsa_pub -> Signkey_data.t option
+ val find_denom_data : denomination_hash -> Denom_data.t option
+ val find_denom_section_name : denomination_hash -> string option
+
+ (* - management operations - *)
+ (* TODO
+ problem of keeping db and secmod state syncronized
+ do db interaction from secmod? *)
+
+ val add_signkey_master_signatures :
+ (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list ->
+ (unit, string) result
+
+ val add_denom_master_signatures :
+ (denomination_hash * Signatures.DenominationKeyValidity.t) list ->
+ (unit, string) result
+
+ val revoke_signkey :
+ eddsa_pub ->
+ Signatures.MasterSigningKeyRevocation.t ->
+ (unit, string) result
+
+ val revoke_denomination :
+ denomination_hash ->
+ Signatures.MasterDenominationKeyRevocation.t ->
+ (unit, string) result
+
+ val store : unit -> (unit, string) result
+end
+
+module Make (Conn : Pg.CONN) = struct
+ (* TODO
+ - key rotation
+ - how many signkey to use?
+ we just use 1 for now
+ - does the secmod's own key as metadata/expiration date?
+ - something to refer to valid sk/dn
+
+ - eddsa.ml with phantom type for key-kind + signed-data-kind *)
+ open Syntax
+ open Crypto
+
+ type signkey = {
+ priv: eddsa_priv;
+ sk_data: Signkey_data.t;
+ }
+
+ type denom = {
+ priv: rsa_priv;
+ dn_data: Denom_data.t;
+ }
+
+ type t = {
+ lock: Miou.Mutex.t;
+ sm_key_priv: eddsa_priv;
+ sm_key_pub: eddsa_pub;
+ sk_ht: (eddsa_pub, signkey) Hashtbl.t;
+ dn_ht: (denomination_hash, denom) Hashtbl.t;
+ dn_section_name_ht: (denomination_hash, string) Hashtbl.t;
+ }
+
+ let dir = Fpath.(v "data" / "secmod")
+
+ let db_lookup_signkey_data conn fname pub =
+ let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
+ match opt with
+ | None ->
+ Fmt.error
+ "load_signkey error, no associated data found in database for \
+ signkey `%s`."
+ (Fpath.to_string fname)
+ | Some sk_data -> Ok sk_data
+
+ let db_lookup_denom_data conn ~section_name priv =
+ let pub = RsaPrivateKey.pub_of_priv priv in
+ let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+ let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
+ match opt with
+ | None ->
+ Fmt.error
+ "load_denom error no associated metadata found in database for \
+ denomination `%s`."
+ section_name
+ | Some dn_data -> Ok dn_data
+
+ let load_signkey conn fname =
+ let* opt = Data_file.read_eddsa fname in
+ match opt with
+ | None -> Ok None
+ | Some priv ->
+ let pub = EddsaPrivateKey.pub_of_priv priv in
+ let* sk_data = db_lookup_signkey_data conn fname pub in
+ let signkey = { priv; sk_data } in
+ Ok (Some signkey)
+
+ let load conn =
+ let error_invalid_state =
+ Fmt.error "secmod load error: invalid store state."
+ in
+ let* sm_key_priv = Data_file.read_eddsa Fpath.(dir / "sk_sm") in
+ let* signkeys =
+ let l = List.init 1 (fun i -> Fpath.(dir / Fmt.str "sk_%d" i)) in
+ let* l = list_map (fun fname -> load_signkey conn fname) l in
+ match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
+ in
+ let dn_section_name_ht = Hashtbl.create 0xff in
+ let* denoms =
+ let* l =
+ let open Config.Coin in
+ list_map
+ (fun coin ->
+ let section_name = coin.section_name in
+ let fname = Fpath.(dir / section_name) in
+ let* opt = Data_file.read_rsa fname in
+ match opt with
+ | None -> Ok None
+ | Some priv ->
+ (* todo: could check that coin config match db values *)
+ let* dn_data = db_lookup_denom_data conn ~section_name priv in
+ Hashtbl.replace dn_section_name_ht dn_data.h_pub section_name;
+ let denom = { priv; dn_data } in
+ Ok (Some denom))
+ all_coins
+ in
+ match Syntax.opt_list l with
+ | Error () -> error_invalid_state
+ | Ok opt -> Ok opt
+ in
+ match (sm_key_priv, signkeys, denoms) with
+ | None, None, None -> Ok None
+ | Some sm_key_priv, Some signkeys, Some denoms ->
+ let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
+ let lock = Miou.Mutex.create () in
+ let sk_ht =
+ signkeys
+ |> List.map (fun v -> (v.sk_data.pub, v))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ let dn_ht =
+ denoms
+ |> List.map (fun v -> (v.dn_data.h_pub, v))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ Ok
+ (Some
+ { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht })
+ | _, _, _ -> error_invalid_state
+
+ let make_new_signkey () =
+ 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 = Time.Timestamp.of_absolute start in
+ let stamp_expire = Time.Timestamp.of_absolute expire in
+ let stamp_end = stamp_expire in
+ let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
+ let master_sig = None in
+ let revoked_sig = None in
+ let sk_data =
+ Signkey_data.
+ { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
+ in
+ { priv; sk_data }
+
+ let make_new_denom
+ 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 open Time in
+ let start = Absolute.of_ptime (Ptime_clock.now ()) in
+ let stamp_start = Timestamp.of_absolute start in
+ let stamp_expire_withdraw =
+ Timestamp.of_absolute @@ Absolute.add start duration_withdraw
+ in
+ let stamp_expire_deposit =
+ Timestamp.of_absolute @@ Absolute.add start duration_spend
+ in
+ let stamp_expire_legal =
+ Timestamp.of_absolute @@ Absolute.add start duration_legal
+ in
+
+ let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in
+ let h_pub = Hash.DenominationHash.hash (RsaPublicKey.to_octets pub) in
+ let master_sig = None in
+ let revoked_sig = None in
+ let dn_data =
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask= 0;
+ h_pub;
+ master_sig;
+ revoked_sig;
+ }
+ in
+ { priv; dn_data }
+
+ let make_new () =
+ let lock = Miou.Mutex.create () in
+ let sm_key_priv, sm_key_pub = Mirage_crypto_ec.Ed25519.generate () in
+ let sk_ht =
+ [ make_new_signkey () ]
+ |> List.map (fun v -> (v.sk_data.pub, v))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ let dn_section_name_ht = Hashtbl.create 0xff in
+ let dn_ht =
+ Config.Coin.all_coins
+ |> List.map (fun coin ->
+ let denom = make_new_denom coin in
+ Hashtbl.replace dn_section_name_ht denom.dn_data.h_pub
+ coin.section_name;
+ (denom.dn_data.h_pub, denom))
+ |> List.to_seq
+ |> Hashtbl.of_seq
+ in
+ { lock; sm_key_priv; sm_key_pub; sk_ht; dn_ht; dn_section_name_ht }
+
+ let t =
+ match load (module Conn) with
+ | Ok None ->
+ let t = make_new () in
+ Logs.info (fun m -> m "secmod initialized with fresh keys");
+ t
+ | Ok (Some t) ->
+ Logs.info (fun m -> m "secmod initialized from storage");
+ t
+ | Error e -> Fmt.failwith "secmod init failure: %s." e
+
+ (* note: don't expose a signing function if we want a real "security module" one day *)
+ let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s
+ let verify_with_sm_key s ~msg = EddsaSignature.verify ~key:t.sm_key_pub s ~msg
+
+ let verify_with_master_key s ~msg =
+ EddsaSignature.verify ~key:Config.master_public_key s ~msg
+
+ (* TODO
+ - do something to force `pub` to be one of the valid signkey
+ how to handle revocation?
+ raise exn for now *)
+ let sign_with_signkey ~pub s =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.sk_ht pub with
+ | None -> Fmt.failwith "secmod failure: public key not found."
+ | Some signkey ->
+ let v = EddsaSignature.sign ~key:signkey.priv s in
+ v
+
+ let verify_with_signkey ~pub s ~msg =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.sk_ht pub with
+ | None -> Error "secmod failure: public key not found."
+ | Some signkey -> EddsaSignature.verify ~key:signkey.sk_data.pub s ~msg
+
+ let get_sm_key_pub () = t.sm_key_pub
+
+ let get_signkeys () =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ Hashtbl.to_seq_values t.sk_ht |> List.of_seq
+
+ let get_denoms () =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ Hashtbl.to_seq_values t.dn_ht |> List.of_seq
+
+ let find_signkey pub =
+ Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.sk_ht pub
+
+ let find_denom h_denom =
+ Miou.Mutex.protect t.lock @@ fun () -> Hashtbl.find_opt t.dn_ht h_denom
+
+ let get_signkeys_data () = get_signkeys () |> List.map (fun v -> v.sk_data)
+ let get_denoms_data () = get_denoms () |> List.map (fun v -> v.dn_data)
+
+ let find_signkey_data pub =
+ find_signkey pub |> Option.map (fun v -> v.sk_data)
+
+ let find_denom_data h_denom =
+ find_denom h_denom |> Option.map (fun v -> v.dn_data)
+
+ let find_denom_section_name h_denom =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ Hashtbl.find_opt t.dn_section_name_ht h_denom
+
+ let add_signkey_master_signatures l =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ list_iter
+ (fun (pub, master_sig) ->
+ match Hashtbl.find_opt t.sk_ht pub with
+ | None -> Error "secmod failure: public key not found."
+ | Some signkey ->
+ let sk_data =
+ { signkey.sk_data with master_sig= Some master_sig }
+ in
+ let signkey = { signkey with sk_data } in
+ let* () =
+ Pg.insert_signkey (module Conn) sk_data |> unwrap_err_caqti
+ in
+ Hashtbl.replace t.sk_ht pub signkey;
+ Ok ())
+ l
+
+ let add_denom_master_signatures l =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ list_iter
+ (fun (h_denom_pub, master_sig) ->
+ match Hashtbl.find_opt t.dn_ht h_denom_pub with
+ | None -> Error "secmod failure: denomination hash not found."
+ | Some denom ->
+ let dn_data = { denom.dn_data with master_sig= Some master_sig } in
+ let denom = { denom with dn_data } in
+ let* () =
+ Pg.insert_denom (module Conn) dn_data |> unwrap_err_caqti
+ in
+ Hashtbl.replace t.dn_ht h_denom_pub denom;
+ Ok ())
+ l
+
+ let revoke_signkey exchange_pub revoked_sig =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.sk_ht exchange_pub with
+ | None -> Error "secmod failure: denomination hash not found."
+ | Some signkey ->
+ let sk_data = { signkey.sk_data with revoked_sig= Some revoked_sig } in
+ let signkey = { signkey with sk_data } in
+ Hashtbl.replace t.sk_ht exchange_pub signkey;
+ Ok ()
+
+ let revoke_denomination h_denom_pub revoked_sig =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ match Hashtbl.find_opt t.dn_ht h_denom_pub with
+ | None -> Error "secmod failure: denomination hash not found."
+ | Some denom ->
+ let dn_data = { denom.dn_data with revoked_sig= Some revoked_sig } in
+ let denom = { denom with dn_data } in
+ Hashtbl.replace t.dn_ht h_denom_pub denom;
+ Ok ()
+
+ let store () =
+ Miou.Mutex.protect t.lock @@ fun () ->
+ let* () = Data_file.write_eddsa Fpath.(dir / "sk_sm") t.sm_key_priv in
+ let* () =
+ Hashtbl.to_seq_values t.sk_ht
+ |> List.of_seq
+ |> List.mapi (fun i (key : signkey) ->
+ let fname = Fpath.(dir / Fmt.str "sk_%d" i) in
+ (fname, key.priv))
+ |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
+ in
+ let* () =
+ let* l =
+ Hashtbl.to_seq_values t.dn_ht
+ |> List.of_seq
+ |> Syntax.list_map (fun (key : denom) ->
+ let+ section_name =
+ match Hashtbl.find_opt t.dn_section_name_ht key.dn_data.h_pub with
+ | None -> Error "invalid state, section_name not found"
+ | Some s -> Ok s
+ in
+ let fname = Fpath.(dir / section_name) in
+ (fname, key.priv))
+ in
+ list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l
+ in
+ Logs.info (fun m -> m "stored secmod data to file");
+ Ok ()
+end
diff --git a/.jjconflict-side-1/src/secmod.mli b/.jjconflict-side-1/src/secmod.mli
new file mode 100644
index 00000000..0205b866
--- /dev/null
+++ b/.jjconflict-side-1/src/secmod.mli
@@ -0,0 +1,46 @@
+module type S = sig
+ open Crypto
+
+ 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
+
+ (* TODO query database instead? *)
+ val get_sm_key_pub : unit -> eddsa_pub
+ val get_signkeys_data : unit -> Signkey_data.t list
+ val get_denoms_data : unit -> Denom_data.t list
+ val find_signkey_data : eddsa_pub -> Signkey_data.t option
+ val find_denom_data : denomination_hash -> Denom_data.t option
+ val find_denom_section_name : denomination_hash -> string option
+
+ (* - management operations - *)
+ (* TODO
+ problem of keeping db and secmod state syncronized
+ do db interaction from secmod? *)
+
+ val add_signkey_master_signatures :
+ (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list ->
+ (unit, string) result
+
+ val add_denom_master_signatures :
+ (denomination_hash * Signatures.DenominationKeyValidity.t) list ->
+ (unit, string) result
+
+ val revoke_signkey :
+ eddsa_pub ->
+ Signatures.MasterSigningKeyRevocation.t ->
+ (unit, string) result
+
+ val revoke_denomination :
+ denomination_hash ->
+ Signatures.MasterDenominationKeyRevocation.t ->
+ (unit, string) result
+
+ val store : unit -> (unit, string) result
+end
+
+module Make (_ : Pg.CONN) : S
diff --git a/.jjconflict-side-1/src/signatures.ml b/.jjconflict-side-1/src/signatures.ml
new file mode 100644
index 00000000..06f44cee
--- /dev/null
+++ b/.jjconflict-side-1/src/signatures.ml
@@ -0,0 +1,1314 @@
+open Hash
+module Taler_signatures = Include.Taler_signatures
+
+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 sign_f ~f r = f (Bin.to_string R.bin r)
+ let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin 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
+ (* TODO 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 debug sig
+ missing field from 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
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *)
+ type r = {
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ purse_timeout: TimeRelativeNBO.t;
+ kyc_timeout: TimeRelativeNBO.t;
+ history_expiration: TimeRelativeNBO.t;
+ history_fee: AmountNBO.t;
+ kyc_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
+ kyc_timeout
+ history_expiration
+ history_fee
+ kyc_fee
+ account_fee
+ purse_fee
+ purse_account_limit
+ ->
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ kyc_timeout;
+ history_expiration;
+ history_fee;
+ kyc_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.kyc_timeout)
+ |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration)
+ |+ field AmountNBO.bin (fun t -> t.history_fee)
+ |+ field AmountNBO.bin (fun t -> t.kyc_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_data.ml b/.jjconflict-side-1/src/signkey_data.ml
new file mode 100644
index 00000000..22a7a0cd
--- /dev/null
+++ b/.jjconflict-side-1/src/signkey_data.ml
@@ -0,0 +1,10 @@
+open Crypto
+
+type t = {
+ pub: eddsa_pub;
+ stamp_start: Timestamp.t;
+ stamp_expire: Timestamp.t;
+ stamp_end: Timestamp.t;
+ master_sig: Signatures.ExchangeSigningKeyValidity.t option;
+ revoked_sig: Signatures.MasterSigningKeyRevocation.t option;
+}
diff --git a/.jjconflict-side-1/src/static.ml b/.jjconflict-side-1/src/static.ml
new file mode 100644
index 00000000..52a7278d
--- /dev/null
+++ b/.jjconflict-side-1/src/static.ml
@@ -0,0 +1,115 @@
+(* TODO check for mathcing ETAG with a middleware instead? *)
+(* /terms + /privacy
+ - try to find a response with an acceptable mime-type
+ - pick the version in the most preferred language of the user
+ - apply compression if that is allowed by the client
+ - set ETAG header
+ - If it did not change, a "304 Not Modified" response will be returned
+ - A "Taler-Terms-Version" header is generated to indicate the legal version of the terms
+ - When returning a full response (not a "304 Not Modified"),
+ include a "Avail-Languages" header: a comma-separated list of the languages available *)
+
+module Respond_with = struct
+ open Vif.Response
+ open Syntax
+
+ open struct
+ let error_detail ?hint _status =
+ let open Api in
+ let code = -1 in
+ let err = ErrorDetail.make ?hint code in
+ let s = encode_exn ErrorDetail.jsont err in
+ Logs.err (fun m -> m "ErrorDetail: `%s`" s);
+ s
+ end
+
+ let bad_request ?hint req =
+ let body = error_detail ?hint `Bad_request in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string ?compression:None req body in
+ respond `Bad_request
+
+ let not_modified () =
+ let* () = empty in
+ respond `Not_modified
+
+ let unsupported_media_type req =
+ let body =
+ error_detail ~hint:"no acceptable mimetype" `Unsupported_media_type
+ in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = add ~field:"accept" Headers.accept_header_value in
+ let* () = with_string ?compression:None req body in
+ respond `Unsupported_media_type
+end
+
+let _aux kind req _server _env =
+ let etag = Assets.etag kind 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.Etag.parse s |> Result.map (Headers_lib.Etag.evaluate etag)
+ in
+ match has_matching_etag with
+ | Error e ->
+ Logs.err (fun m -> m "bad request");
+ Respond_with.bad_request ~hint:e req
+ | Ok true ->
+ Logs.err (fun m -> m "not modified");
+ Respond_with.not_modified ()
+ | Ok false -> (
+ match Headers.select_mimetype headers with
+ | None ->
+ Logs.err (fun m -> m "unsupported_media_type");
+ Respond_with.unsupported_media_type req
+ | Some mime ->
+ let lang = Headers.select_language headers in
+ let compression = Headers.select_encoding headers in
+ let data = Assets.get_content ~mime ~lang kind 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_value etag in
+ add ~field:"etag" etag_field_value
+ in
+ let* () =
+ (* todo: is it "taler-privacy-version" for /policy ? *)
+ add ~field:"taler-terms-version" Assets.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 mime in
+ add ~field:"content-type" content_type
+ in
+ respond `OK)
+
+(* WIP DEBUG *)
+let aux _kind req _server _env =
+ let open Vif.Response in
+ let open Syntax in
+ let data = "uhuh" in
+ let etag = "0" in
+ let content_type = "text/plain" in
+ let* () = with_string req data in
+ let* () = add ~field:"etag" etag in
+ let* () =
+ (* todo: is it "taler-privacy-version" for /policy ? *)
+ add ~field:"taler-terms-version" Assets.terms_legal_version
+ in
+ let* () = add ~field:"avail-languages" Headers.avail_languages_header_value in
+ let* () = add ~field:"content-type" content_type 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/syntax.ml b/.jjconflict-side-1/src/syntax.ml
new file mode 100644
index 00000000..c61aba15
--- /dev/null
+++ b/.jjconflict-side-1/src/syntax.ml
@@ -0,0 +1,51 @@
+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/time.ml b/.jjconflict-side-1/src/time.ml
new file mode 100644
index 00000000..3c5af371
--- /dev/null
+++ b/.jjconflict-side-1/src/time.ml
@@ -0,0 +1,151 @@
+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
new file mode 100644
index 00000000..180df904
--- /dev/null
+++ b/.jjconflict-side-1/src/time.mli
@@ -0,0 +1,54 @@
+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
new file mode 100644
index 00000000..1a942758
--- /dev/null
+++ b/.jjconflict-side-1/src/timestamp.ml
@@ -0,0 +1 @@
+include Time.Timestamp
diff --git a/.jjconflict-side-1/src/util.ml b/.jjconflict-side-1/src/util.ml
new file mode 100644
index 00000000..c690a009
--- /dev/null
+++ b/.jjconflict-side-1/src/util.ml
@@ -0,0 +1,62 @@
+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/dune b/.jjconflict-side-1/test/dune
new file mode 100644
index 00000000..1eefa8ef
--- /dev/null
+++ b/.jjconflict-side-1/test/dune
@@ -0,0 +1,11 @@
+(test
+ (name test)
+ (modules test)
+ (libraries mte fmt))
+
+; TODO
+; cram test?
+; gcc -o a.out ./test/signatures.c && ./a.out > a.output
+; rm ./a.out
+; dune exec ./test/test.exe > b.output
+; cmp -l a.output b.output
diff --git a/.jjconflict-side-1/test/offline_management.sh b/.jjconflict-side-1/test/offline_management.sh
new file mode 100755
index 00000000..a4999491
--- /dev/null
+++ b/.jjconflict-side-1/test/offline_management.sh
@@ -0,0 +1,45 @@
+#!/bin/bash
+
+set -e
+
+a="tmp_a.json"
+b="tmp_b.json"
+
+auditor_pub=$(<"./data/auditor_public_key")
+zero_euro="EUR:0.0"
+
+dune exec offline -- download --output $a
+dune exec offline -- sign --input $a --output $b
+dune exec offline -- upload --input $b --url "/management/keys"
+
+dune exec offline -- enable-auditor \
+--output $b \
+--auditor_url "auditor.example.com" \
+--auditor_name "auditor example" \
+--auditor_pub $auditor_pub \
+--validity_start 0
+dune exec offline -- upload --input $b --url "/management/auditors"
+
+dune exec offline -- wire-fee \
+--output $b \
+--wire_method "magic" \
+--fee_start 0 \
+--fee_end 99999999 \
+--closing_fee $zero_euro \
+--wire_fee $zero_euro
+dune exec offline -- upload --input $b --url "/management/wire-fee"
+
+dune exec offline -- global-fees \
+--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
+dune exec offline -- upload --input $b --url "/management/global-fees"
+
+rm $a
+rm $b
diff --git a/.jjconflict-side-1/test/signatures.c b/.jjconflict-side-1/test/signatures.c
new file mode 100644
index 00000000..bcebe993
--- /dev/null
+++ b/.jjconflict-side-1/test/signatures.c
@@ -0,0 +1,55 @@
+#include
+#include
+
+struct H64 {
+ uint8_t hash[64];
+};
+struct Hhh {
+ struct H64 hash;
+};
+struct Purpose {
+ uint32_t size;
+ uint32_t purpose;
+};
+
+struct PS {
+ struct Purpose purpose;
+ struct Hhh h;
+ uint32_t noreveal_index;
+};
+
+int main(void) {
+ struct Purpose purpose;
+ struct PS ps;
+
+ purpose.size = 3 * 4 + 64;
+ purpose.purpose = 1050;
+
+ struct Hhh h = {
+ .hash = {
+ .hash = {
+ 1 , 2 , 3 , 4 , 5, 6, 7, 8,
+ 9 , 10, 11, 12, 13, 14, 15, 16,
+ 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, 40,
+ 41, 42, 43, 44, 45, 46, 47, 48,
+ 49, 50, 51, 52, 53, 54, 55, 56,
+ 57, 58, 59, 60, 61, 62, 63, 64
+ }
+ }
+ };
+
+ uint32_t noreveal_index = 0;
+
+ ps.purpose = purpose;
+ ps.h = h;
+ ps.noreveal_index = noreveal_index;
+
+
+ fwrite(&ps, sizeof(ps), 1, stdout);
+
+ // printf("\n");
+
+ return 0;
+}
diff --git a/test/test.ml b/.jjconflict-side-1/test/test.ml
similarity index 100%
rename from test/test.ml
rename to .jjconflict-side-1/test/test.ml
diff --git a/.jjconflict-side-1/tools/dune b/.jjconflict-side-1/tools/dune
new file mode 100644
index 00000000..f500902e
--- /dev/null
+++ b/.jjconflict-side-1/tools/dune
@@ -0,0 +1,7 @@
+(executable
+ (public_name offline)
+ (name offline)
+ (modules offline offline_impl offline_sig)
+ (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
+
+; todo depends on curl
diff --git a/.jjconflict-side-1/tools/offline.ml b/.jjconflict-side-1/tools/offline.ml
new file mode 100644
index 00000000..f40664fd
--- /dev/null
+++ b/.jjconflict-side-1/tools/offline.ml
@@ -0,0 +1,313 @@
+(* TODO
+ all management operations:
+ /management/wire
+ /management/wire/disable
+ -> how to build WireSetupMessage?
+ we need additional data to craft master_sig
+ maybe supposed to be found in the full payto-uri?
+
+ /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 default_master_offline_key_file = "data/master_offline_private_key"
+(*
+let default_response_file = "response.json"
+let default_request_file = "request.json"
+*)
+
+let master_key =
+ let doc = "Master offline Eddsa private key file." in
+ Arg.(
+ value
+ & opt file default_master_offline_key_file
+ & info [ "master_key_file" ] ~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" in
+ let output =
+ let doc = "output file" in
+ Arg.(
+ value
+ & opt filepath default_master_offline_key_file
+ & info [ "o"; "output" ] ~doc)
+ in
+ Cmd.make (Cmd.info "setup" ~doc)
+ @@
+ let+ output = output in
+ setup ~output
+
+let download_cmd =
+ let doc = "GET /management/keys/" in
+ let man =
+ [ `S Manpage.s_description; `P "$(cmd) download /management/keys." ]
+ in
+ Cmd.make (Cmd.info "download" ~doc ~man)
+ @@
+ let+ output = output in
+ download ~output
+
+let upload_cmd =
+ let doc = "POST input.json data to url (default /management/keys)" 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
new file mode 100644
index 00000000..3438ec66
--- /dev/null
+++ b/.jjconflict-side-1/tools/offline_impl.ml
@@ -0,0 +1,230 @@
+open Syntax
+open Hash
+
+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 base_url = Uri.of_string "http://localhost:3434/"
+let full_url path = Uri.with_path base_url path |> Uri.to_string
+
+let download ~output =
+ let open Bos in
+ let uri = full_url "/management/keys/" in
+ OS.Cmd.run Cmd.(v "curl" % "-s" % "-o" % output % "-X" % "GET" % uri)
+ |> unwrap_err_msg
+
+let upload ~input ~url =
+ let open Bos in
+ let uri = full_url url in
+ OS.Cmd.run
+ Cmd.(
+ v "curl"
+ % "-i"
+ % "-X"
+ % "POST"
+ % "-H"
+ % "Content-Type: application/json"
+ % "--data"
+ % ("@" ^ input)
+ % uri)
+ |> unwrap_err_msg
+
+let setup ~output =
+ let () = Mirage_crypto_rng_unix.use_default () in
+ let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
+ Fmt.pr "generated master public key:@\n%s@."
+ (Mirage_crypto_ec.Ed25519.pub_to_octets pub |> B32.encode);
+ let priv_data = Mirage_crypto_ec.Ed25519.priv_to_octets priv in
+ write_file output priv_data
+
+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* () =
+ Offline_sig.verify_future_keys_response master_pub future_keys_response
+ in
+ let master_signatures =
+ Offline_sig.mk_future_keys ~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
+ (* TODO KYC *)
+ let kyc_timeout = Time.Relative.forever in
+ let kyc_fee = Amount.dummy_value in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ kyc_timeout;
+ history_expiration;
+ history_fee;
+ kyc_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/offline_sig.ml b/.jjconflict-side-1/tools/offline_sig.ml
new file mode 100644
index 00000000..f89cca19
--- /dev/null
+++ b/.jjconflict-side-1/tools/offline_sig.ml
@@ -0,0 +1,147 @@
+open Crypto
+open Api
+
+let verify_future_keys_response =
+ 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 open Syntax in
+ 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 mk_future_keys =
+ 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 }
diff --git a/README b/README
new file mode 100644
index 00000000..5be01972
--- /dev/null
+++ b/README
@@ -0,0 +1,11 @@
+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.