From 7b299b1bd4f235b06f944e4a2d8e231eedb21484 Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 7 Feb 2026 00:27:44 +0100 Subject: [PATCH] --- .jjconflict-base-0/.gitignore => .gitignore | 0 .jjconflict-base-0/test/test.ml | 128 -- .jjconflict-side-0/.gitignore | 3 - .jjconflict-side-0/.ocamlformat | 15 - .jjconflict-side-0/LICENSE | 661 -------- .jjconflict-side-0/data/assets/default.config | 74 - .../data/assets/privacy/en/0.md | 1 - .../data/assets/privacy/en/0.txt | 1 - .jjconflict-side-0/data/assets/terms/en/0.md | 1 - .jjconflict-side-0/data/assets/terms/en/0.txt | 1 - .jjconflict-side-0/data/auditor_private_key | 1 - .jjconflict-side-0/data/auditor_public_key | 1 - .../data/master_offline_private_key | Bin 32 -> 0 bytes .jjconflict-side-0/data/secmod/.gitkeep | 0 .jjconflict-side-0/dune-project | 46 - .jjconflict-side-0/include/dune | 5 - .../include/taler_signatures.ml | 78 - .jjconflict-side-0/mte.opam | 49 - .jjconflict-side-0/src/amount.ml | 121 -- .jjconflict-side-0/src/amount.mli | 34 - .jjconflict-side-0/src/api.ml | 1347 ----------------- .jjconflict-side-0/src/assets.ml | 150 -- .jjconflict-side-0/src/b32.ml | 38 - .jjconflict-side-0/src/config.ml | 200 --- .jjconflict-side-0/src/crypto.ml | 300 ---- .jjconflict-side-0/src/data_file.ml | 35 - .jjconflict-side-0/src/denom_data.ml | 18 - .jjconflict-side-0/src/devices.ml | 26 - .jjconflict-side-0/src/dune | 45 - .jjconflict-side-0/src/hash.ml | 108 -- .jjconflict-side-0/src/headers.ml | 52 - .jjconflict-side-0/src/headers_lib.ml | 86 -- .jjconflict-side-0/src/http_keys.ml | 262 ---- .jjconflict-side-0/src/http_management.ml | 749 --------- .jjconflict-side-0/src/mte.ml | 77 - .jjconflict-side-0/src/parse_config.ml | 262 ---- .jjconflict-side-0/src/pg.ml | 374 ----- .jjconflict-side-0/src/pg_type.ml | 377 ----- .jjconflict-side-0/src/respond_util.ml | 22 - .jjconflict-side-0/src/secmod.ml | 407 ----- .jjconflict-side-0/src/secmod.mli | 46 - .jjconflict-side-0/src/signatures.ml | 1308 ---------------- .jjconflict-side-0/src/signkey_data.ml | 10 - .jjconflict-side-0/src/static.ml | 84 - .jjconflict-side-0/src/syntax.ml | 51 - .jjconflict-side-0/src/time.ml | 151 -- .jjconflict-side-0/src/time.mli | 54 - .jjconflict-side-0/src/timestamp.ml | 1 - .jjconflict-side-0/src/util.ml | 62 - .jjconflict-side-0/test/dune | 11 - .jjconflict-side-0/test/offline_management.sh | 45 - .jjconflict-side-0/test/signatures.c | 55 - .jjconflict-side-0/test/test.ml | 110 -- .jjconflict-side-0/tools/dune | 7 - .jjconflict-side-0/tools/offline.ml | 313 ---- .jjconflict-side-0/tools/offline_impl.ml | 230 --- .jjconflict-side-0/tools/offline_sig.ml | 146 -- .jjconflict-side-1/.gitignore | 3 - .jjconflict-side-1/.ocamlformat | 15 - .jjconflict-side-1/LICENSE | 661 -------- .jjconflict-side-1/data/assets/default.config | 74 - .../data/assets/privacy/en/0.md | 1 - .../data/assets/privacy/en/0.txt | 1 - .jjconflict-side-1/data/assets/terms/en/0.md | 1 - .jjconflict-side-1/data/assets/terms/en/0.txt | 1 - .jjconflict-side-1/data/auditor_private_key | 1 - .jjconflict-side-1/data/auditor_public_key | 1 - .../data/master_offline_private_key | Bin 32 -> 0 bytes .jjconflict-side-1/data/secmod/.gitkeep | 0 .jjconflict-side-1/dune-project | 46 - .jjconflict-side-1/include/dune | 5 - .../include/taler_signatures.ml | 78 - .jjconflict-side-1/mte.opam | 49 - .jjconflict-side-1/src/amount.ml | 121 -- .jjconflict-side-1/src/amount.mli | 34 - .jjconflict-side-1/src/api.ml | 1347 ----------------- .jjconflict-side-1/src/assets.ml | 150 -- .jjconflict-side-1/src/b32.ml | 38 - .jjconflict-side-1/src/config.ml | 200 --- .jjconflict-side-1/src/crypto.ml | 300 ---- .jjconflict-side-1/src/data_file.ml | 35 - .jjconflict-side-1/src/denom_data.ml | 18 - .jjconflict-side-1/src/devices.ml | 26 - .jjconflict-side-1/src/dune | 45 - .jjconflict-side-1/src/hash.ml | 108 -- .jjconflict-side-1/src/headers.ml | 52 - .jjconflict-side-1/src/headers_lib.ml | 86 -- .jjconflict-side-1/src/http_keys.ml | 262 ---- .jjconflict-side-1/src/http_management.ml | 749 --------- .jjconflict-side-1/src/mte.ml | 77 - .jjconflict-side-1/src/parse_config.ml | 262 ---- .jjconflict-side-1/src/pg.ml | 374 ----- .jjconflict-side-1/src/pg_type.ml | 377 ----- .jjconflict-side-1/src/respond_util.ml | 22 - .jjconflict-side-1/src/secmod.ml | 407 ----- .jjconflict-side-1/src/secmod.mli | 46 - .jjconflict-side-1/src/signatures.ml | 1308 ---------------- .jjconflict-side-1/src/signkey_data.ml | 10 - .jjconflict-side-1/src/static.ml | 84 - .jjconflict-side-1/src/syntax.ml | 51 - .jjconflict-side-1/src/time.ml | 151 -- .jjconflict-side-1/src/time.mli | 54 - .jjconflict-side-1/src/timestamp.ml | 1 - .jjconflict-side-1/src/util.ml | 62 - .jjconflict-side-1/test/dune | 11 - .jjconflict-side-1/test/offline_management.sh | 45 - .jjconflict-side-1/test/signatures.c | 55 - .jjconflict-side-1/tools/dune | 7 - .jjconflict-side-1/tools/offline.ml | 313 ---- .jjconflict-side-1/tools/offline_impl.ml | 230 --- .jjconflict-side-1/tools/offline_sig.ml | 146 -- .../.ocamlformat => .ocamlformat | 0 .jjconflict-base-0/LICENSE => LICENSE | 0 README | 11 - .../data => data}/assets/default.config | 0 .../data => data}/assets/privacy/en/0.md | 0 .../data => data}/assets/privacy/en/0.txt | 0 .../data => data}/assets/terms/en/0.md | 0 .../data => data}/assets/terms/en/0.txt | 0 .../data => data}/auditor_private_key | 0 .../data => data}/auditor_public_key | 0 .../data => data}/master_offline_private_key | Bin .../data => data}/secmod/.gitkeep | 0 .../dune-project => dune-project | 0 {.jjconflict-base-0/include => include}/dune | 0 .../include => include}/taler_signatures.ml | 0 .jjconflict-base-0/mte.opam => mte.opam | 0 {.jjconflict-base-0/src => src}/amount.ml | 0 {.jjconflict-base-0/src => src}/amount.mli | 0 {.jjconflict-base-0/src => src}/api.ml | 0 {.jjconflict-base-0/src => src}/assets.ml | 0 {.jjconflict-base-0/src => src}/b32.ml | 0 {.jjconflict-base-0/src => src}/config.ml | 0 {.jjconflict-base-0/src => src}/crypto.ml | 0 {.jjconflict-base-0/src => src}/data_file.ml | 0 {.jjconflict-base-0/src => src}/denom_data.ml | 0 {.jjconflict-base-0/src => src}/devices.ml | 0 {.jjconflict-base-0/src => src}/dune | 0 {.jjconflict-base-0/src => src}/hash.ml | 0 {.jjconflict-base-0/src => src}/headers.ml | 0 .../src => src}/headers_lib.ml | 0 {.jjconflict-base-0/src => src}/http_keys.ml | 0 .../src => src}/http_management.ml | 0 {.jjconflict-base-0/src => src}/mte.ml | 0 .../src => src}/parse_config.ml | 0 {.jjconflict-base-0/src => src}/pg.ml | 0 {.jjconflict-base-0/src => src}/pg_type.ml | 0 .../src => src}/respond_util.ml | 0 {.jjconflict-base-0/src => src}/secmod.ml | 0 {.jjconflict-base-0/src => src}/secmod.mli | 0 {.jjconflict-base-0/src => src}/signatures.ml | 0 .../src => src}/signkey_data.ml | 0 {.jjconflict-base-0/src => src}/static.ml | 0 {.jjconflict-base-0/src => src}/syntax.ml | 0 {.jjconflict-base-0/src => src}/time.ml | 0 {.jjconflict-base-0/src => src}/time.mli | 0 {.jjconflict-base-0/src => src}/timestamp.ml | 0 {.jjconflict-base-0/src => src}/util.ml | 0 {.jjconflict-base-0/test => test}/dune | 0 .../test => test}/offline_management.sh | 0 .../test => test}/signatures.c | 0 {.jjconflict-side-1/test => test}/test.ml | 0 {.jjconflict-base-0/tools => tools}/dune | 0 .../tools => tools}/offline.ml | 0 .../tools => tools}/offline_impl.ml | 0 .../tools => tools}/offline_sig.ml | 0 166 files changed, 17451 deletions(-) rename .jjconflict-base-0/.gitignore => .gitignore (100%) delete mode 100644 .jjconflict-base-0/test/test.ml delete mode 100644 .jjconflict-side-0/.gitignore delete mode 100644 .jjconflict-side-0/.ocamlformat delete mode 100644 .jjconflict-side-0/LICENSE delete mode 100644 .jjconflict-side-0/data/assets/default.config delete mode 100644 .jjconflict-side-0/data/assets/privacy/en/0.md delete mode 100644 .jjconflict-side-0/data/assets/privacy/en/0.txt delete mode 100644 .jjconflict-side-0/data/assets/terms/en/0.md delete mode 100644 .jjconflict-side-0/data/assets/terms/en/0.txt delete mode 100644 .jjconflict-side-0/data/auditor_private_key delete mode 100644 .jjconflict-side-0/data/auditor_public_key delete mode 100644 .jjconflict-side-0/data/master_offline_private_key delete mode 100644 .jjconflict-side-0/data/secmod/.gitkeep delete mode 100644 .jjconflict-side-0/dune-project delete mode 100644 .jjconflict-side-0/include/dune delete mode 100644 .jjconflict-side-0/include/taler_signatures.ml delete mode 100644 .jjconflict-side-0/mte.opam delete mode 100644 .jjconflict-side-0/src/amount.ml delete mode 100644 .jjconflict-side-0/src/amount.mli delete mode 100644 .jjconflict-side-0/src/api.ml delete mode 100644 .jjconflict-side-0/src/assets.ml delete mode 100644 .jjconflict-side-0/src/b32.ml delete mode 100644 .jjconflict-side-0/src/config.ml delete mode 100644 .jjconflict-side-0/src/crypto.ml delete mode 100644 .jjconflict-side-0/src/data_file.ml delete mode 100644 .jjconflict-side-0/src/denom_data.ml delete mode 100644 .jjconflict-side-0/src/devices.ml delete mode 100644 .jjconflict-side-0/src/dune delete mode 100644 .jjconflict-side-0/src/hash.ml delete mode 100644 .jjconflict-side-0/src/headers.ml delete mode 100644 .jjconflict-side-0/src/headers_lib.ml delete mode 100644 .jjconflict-side-0/src/http_keys.ml delete mode 100644 .jjconflict-side-0/src/http_management.ml delete mode 100644 .jjconflict-side-0/src/mte.ml delete mode 100644 .jjconflict-side-0/src/parse_config.ml delete mode 100644 .jjconflict-side-0/src/pg.ml delete mode 100644 .jjconflict-side-0/src/pg_type.ml delete mode 100644 .jjconflict-side-0/src/respond_util.ml delete mode 100644 .jjconflict-side-0/src/secmod.ml delete mode 100644 .jjconflict-side-0/src/secmod.mli delete mode 100644 .jjconflict-side-0/src/signatures.ml delete mode 100644 .jjconflict-side-0/src/signkey_data.ml delete mode 100644 .jjconflict-side-0/src/static.ml delete mode 100644 .jjconflict-side-0/src/syntax.ml delete mode 100644 .jjconflict-side-0/src/time.ml delete mode 100644 .jjconflict-side-0/src/time.mli delete mode 100644 .jjconflict-side-0/src/timestamp.ml delete mode 100644 .jjconflict-side-0/src/util.ml delete mode 100644 .jjconflict-side-0/test/dune delete mode 100755 .jjconflict-side-0/test/offline_management.sh delete mode 100644 .jjconflict-side-0/test/signatures.c delete mode 100644 .jjconflict-side-0/test/test.ml delete mode 100644 .jjconflict-side-0/tools/dune delete mode 100644 .jjconflict-side-0/tools/offline.ml delete mode 100644 .jjconflict-side-0/tools/offline_impl.ml delete mode 100644 .jjconflict-side-0/tools/offline_sig.ml delete mode 100644 .jjconflict-side-1/.gitignore delete mode 100644 .jjconflict-side-1/.ocamlformat delete mode 100644 .jjconflict-side-1/LICENSE delete mode 100644 .jjconflict-side-1/data/assets/default.config delete mode 100644 .jjconflict-side-1/data/assets/privacy/en/0.md delete mode 100644 .jjconflict-side-1/data/assets/privacy/en/0.txt delete mode 100644 .jjconflict-side-1/data/assets/terms/en/0.md delete mode 100644 .jjconflict-side-1/data/assets/terms/en/0.txt delete mode 100644 .jjconflict-side-1/data/auditor_private_key delete mode 100644 .jjconflict-side-1/data/auditor_public_key delete mode 100644 .jjconflict-side-1/data/master_offline_private_key delete mode 100644 .jjconflict-side-1/data/secmod/.gitkeep delete mode 100644 .jjconflict-side-1/dune-project delete mode 100644 .jjconflict-side-1/include/dune delete mode 100644 .jjconflict-side-1/include/taler_signatures.ml delete mode 100644 .jjconflict-side-1/mte.opam delete mode 100644 .jjconflict-side-1/src/amount.ml delete mode 100644 .jjconflict-side-1/src/amount.mli delete mode 100644 .jjconflict-side-1/src/api.ml delete mode 100644 .jjconflict-side-1/src/assets.ml delete mode 100644 .jjconflict-side-1/src/b32.ml delete mode 100644 .jjconflict-side-1/src/config.ml delete mode 100644 .jjconflict-side-1/src/crypto.ml delete mode 100644 .jjconflict-side-1/src/data_file.ml delete mode 100644 .jjconflict-side-1/src/denom_data.ml delete mode 100644 .jjconflict-side-1/src/devices.ml delete mode 100644 .jjconflict-side-1/src/dune delete mode 100644 .jjconflict-side-1/src/hash.ml delete mode 100644 .jjconflict-side-1/src/headers.ml delete mode 100644 .jjconflict-side-1/src/headers_lib.ml delete mode 100644 .jjconflict-side-1/src/http_keys.ml delete mode 100644 .jjconflict-side-1/src/http_management.ml delete mode 100644 .jjconflict-side-1/src/mte.ml delete mode 100644 .jjconflict-side-1/src/parse_config.ml delete mode 100644 .jjconflict-side-1/src/pg.ml delete mode 100644 .jjconflict-side-1/src/pg_type.ml delete mode 100644 .jjconflict-side-1/src/respond_util.ml delete mode 100644 .jjconflict-side-1/src/secmod.ml delete mode 100644 .jjconflict-side-1/src/secmod.mli delete mode 100644 .jjconflict-side-1/src/signatures.ml delete mode 100644 .jjconflict-side-1/src/signkey_data.ml delete mode 100644 .jjconflict-side-1/src/static.ml delete mode 100644 .jjconflict-side-1/src/syntax.ml delete mode 100644 .jjconflict-side-1/src/time.ml delete mode 100644 .jjconflict-side-1/src/time.mli delete mode 100644 .jjconflict-side-1/src/timestamp.ml delete mode 100644 .jjconflict-side-1/src/util.ml delete mode 100644 .jjconflict-side-1/test/dune delete mode 100755 .jjconflict-side-1/test/offline_management.sh delete mode 100644 .jjconflict-side-1/test/signatures.c delete mode 100644 .jjconflict-side-1/tools/dune delete mode 100644 .jjconflict-side-1/tools/offline.ml delete mode 100644 .jjconflict-side-1/tools/offline_impl.ml delete mode 100644 .jjconflict-side-1/tools/offline_sig.ml rename .jjconflict-base-0/.ocamlformat => .ocamlformat (100%) rename .jjconflict-base-0/LICENSE => LICENSE (100%) delete mode 100644 README rename {.jjconflict-base-0/data => data}/assets/default.config (100%) rename {.jjconflict-base-0/data => data}/assets/privacy/en/0.md (100%) rename {.jjconflict-base-0/data => data}/assets/privacy/en/0.txt (100%) rename {.jjconflict-base-0/data => data}/assets/terms/en/0.md (100%) rename {.jjconflict-base-0/data => data}/assets/terms/en/0.txt (100%) rename {.jjconflict-base-0/data => data}/auditor_private_key (100%) rename {.jjconflict-base-0/data => data}/auditor_public_key (100%) rename {.jjconflict-base-0/data => data}/master_offline_private_key (100%) rename {.jjconflict-base-0/data => data}/secmod/.gitkeep (100%) rename .jjconflict-base-0/dune-project => dune-project (100%) rename {.jjconflict-base-0/include => include}/dune (100%) rename {.jjconflict-base-0/include => include}/taler_signatures.ml (100%) rename .jjconflict-base-0/mte.opam => mte.opam (100%) rename {.jjconflict-base-0/src => src}/amount.ml (100%) rename {.jjconflict-base-0/src => src}/amount.mli (100%) rename {.jjconflict-base-0/src => src}/api.ml (100%) rename {.jjconflict-base-0/src => src}/assets.ml (100%) rename {.jjconflict-base-0/src => src}/b32.ml (100%) rename {.jjconflict-base-0/src => src}/config.ml (100%) rename {.jjconflict-base-0/src => src}/crypto.ml (100%) rename {.jjconflict-base-0/src => src}/data_file.ml (100%) rename {.jjconflict-base-0/src => src}/denom_data.ml (100%) rename {.jjconflict-base-0/src => src}/devices.ml (100%) rename {.jjconflict-base-0/src => src}/dune (100%) rename {.jjconflict-base-0/src => src}/hash.ml (100%) rename {.jjconflict-base-0/src => src}/headers.ml (100%) rename {.jjconflict-base-0/src => src}/headers_lib.ml (100%) rename {.jjconflict-base-0/src => src}/http_keys.ml (100%) rename {.jjconflict-base-0/src => src}/http_management.ml (100%) rename {.jjconflict-base-0/src => src}/mte.ml (100%) rename {.jjconflict-base-0/src => src}/parse_config.ml (100%) rename {.jjconflict-base-0/src => src}/pg.ml (100%) rename {.jjconflict-base-0/src => src}/pg_type.ml (100%) rename {.jjconflict-base-0/src => src}/respond_util.ml (100%) rename {.jjconflict-base-0/src => src}/secmod.ml (100%) rename {.jjconflict-base-0/src => src}/secmod.mli (100%) rename {.jjconflict-base-0/src => src}/signatures.ml (100%) rename {.jjconflict-base-0/src => src}/signkey_data.ml (100%) rename {.jjconflict-base-0/src => src}/static.ml (100%) rename {.jjconflict-base-0/src => src}/syntax.ml (100%) rename {.jjconflict-base-0/src => src}/time.ml (100%) rename {.jjconflict-base-0/src => src}/time.mli (100%) rename {.jjconflict-base-0/src => src}/timestamp.ml (100%) rename {.jjconflict-base-0/src => src}/util.ml (100%) rename {.jjconflict-base-0/test => test}/dune (100%) rename {.jjconflict-base-0/test => test}/offline_management.sh (100%) rename {.jjconflict-base-0/test => test}/signatures.c (100%) rename {.jjconflict-side-1/test => test}/test.ml (100%) rename {.jjconflict-base-0/tools => tools}/dune (100%) rename {.jjconflict-base-0/tools => tools}/offline.ml (100%) rename {.jjconflict-base-0/tools => tools}/offline_impl.ml (100%) rename {.jjconflict-base-0/tools => tools}/offline_sig.ml (100%) diff --git a/.jjconflict-base-0/.gitignore b/.gitignore similarity index 100% rename from .jjconflict-base-0/.gitignore rename to .gitignore diff --git a/.jjconflict-base-0/test/test.ml b/.jjconflict-base-0/test/test.ml deleted file mode 100644 index 21803e30..00000000 --- a/.jjconflict-base-0/test/test.ml +++ /dev/null @@ -1,128 +0,0 @@ -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/.gitignore b/.jjconflict-side-0/.gitignore deleted file mode 100644 index dbd4866f..00000000 --- a/.jjconflict-side-0/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -_build -data/secmod/* -!data/secmod/.gitkeep diff --git a/.jjconflict-side-0/.ocamlformat b/.jjconflict-side-0/.ocamlformat deleted file mode 100644 index 43b12fc0..00000000 --- a/.jjconflict-side-0/.ocamlformat +++ /dev/null @@ -1,15 +0,0 @@ -version=0.28.1 -exp-grouping=preserve -type-decl=sparse -break-infix=fit-or-vertical -break-collection-expressions=fit-or-vertical -break-sequences=false -break-infix-before-func=false -dock-collection-brackets=true -break-separators=after -field-space=tight -if-then-else=compact -break-sequences=false -sequence-blank-line=compact -exp-grouping=preserve -sequence-blank-line=preserve-one diff --git a/.jjconflict-side-0/LICENSE b/.jjconflict-side-0/LICENSE deleted file mode 100644 index be3f7b28..00000000 --- a/.jjconflict-side-0/LICENSE +++ /dev/null @@ -1,661 +0,0 @@ - GNU AFFERO GENERAL PUBLIC LICENSE - Version 3, 19 November 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU Affero General Public License is a free, copyleft license for -software and other kinds of works, specifically designed to ensure -cooperation with the community in the case of network server software. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -our General Public Licenses are intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - Developers that use our General Public Licenses protect your rights -with two steps: (1) assert copyright on the software, and (2) offer -you this License which gives you legal permission to copy, distribute -and/or modify the software. - - A secondary benefit of defending all users' freedom is that -improvements made in alternate versions of the program, if they -receive widespread use, become available for other developers to -incorporate. Many developers of free software are heartened and -encouraged by the resulting cooperation. However, in the case of -software used on network servers, this result may fail to come about. -The GNU General Public License permits making a modified version and -letting the public access it on a server without ever releasing its -source code to the public. - - The GNU Affero General Public License is designed specifically to -ensure that, in such cases, the modified source code becomes available -to the community. It requires the operator of a network server to -provide the source code of the modified version running there to the -users of that server. Therefore, public use of a modified version, on -a publicly accessible server, gives the public access to the source -code of the modified version. - - An older license, called the Affero General Public License and -published by Affero, was designed to accomplish similar goals. This is -a different license, not a version of the Affero GPL, but Affero has -released a new version of the Affero GPL which permits relicensing under -this license. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU Affero General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Remote Network Interaction; Use with the GNU General Public License. - - Notwithstanding any other provision of this License, if you modify the -Program, your modified version must prominently offer all users -interacting with it remotely through a computer network (if your version -supports such interaction) an opportunity to receive the Corresponding -Source of your version by providing access to the Corresponding Source -from a network server at no charge, through some standard or customary -means of facilitating copying of software. This Corresponding Source -shall include the Corresponding Source for any work covered by version 3 -of the GNU General Public License that is incorporated pursuant to the -following paragraph. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the work with which it is combined will remain governed by version -3 of the GNU General Public License. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU Affero General Public License from time to time. Such new versions -will be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU Affero General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU Affero General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU Affero General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Affero General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Affero General Public License for more details. - - You should have received a copy of the GNU Affero General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If your software can interact with users remotely through a computer -network, you should also make sure that it provides a way for users to -get its source. For example, if your program is a web application, its -interface could display a "Source" link that leads users to an archive -of the code. There are many ways you could offer source, and different -solutions will be better for different programs; see section 13 for the -specific requirements. - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU AGPL, see -. diff --git a/.jjconflict-side-0/data/assets/default.config b/.jjconflict-side-0/data/assets/default.config deleted file mode 100644 index a6c89c52..00000000 --- a/.jjconflict-side-0/data/assets/default.config +++ /dev/null @@ -1,74 +0,0 @@ -[currency-EUR] -enabled= YES -code= EUR -name= euro -fractional_input_digits= 2 -fractional_normal_digits= 2 -fractional_trailing_zero_digits= 2 -alt_unit_names= "{"0":"€","3":"k€"}" - -[exchange] -currency = EUR -currency_round_unit = EUR:0.01 -db = postgres -attribute_encryption_key = "deadbeef" -port = 3434 -bind_to = localhost -master_public_key = "SJ0NYND22VQP3MP7FM754RDX8HCKVWAXTHY9SQNBTPRJZ2SPM2S0" -stefan_abs = EUR:0.00 -stefan_log = EUR:0.00 -stefan_lin = 0.00 -aggregator_idle_sleep_interval = "1 hour" -closer_idle_sleep_interval = "1 hour" -transfer_idle_sleep_interval = "1 hour" -wirewatch_idle_sleep_interval = "1 hour" -signkey_legal_duration = "1 year" -max_keys_caching = "4 weeks" -enable_kyc = NO -terms_etag = "0" -privacy_etag = "0" -base_url = "http://localhost:3434/" - -[exchangedb] -idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds" -legal_reserve_expiration_time = "1 year" -aggregator_shift = "1 year" -max_aml_program_runtime = "1 year" -default_purse_limit = 9999 - -[exchangedb-postgres] -config = "pgx://mte:hunter2@localhost:5432/taler-exchange" - -[taler-exchange-secmod-rsa] -lookahead_sign = "1 year" -overlap_duration = "1 year" - -[taler-exchange-secmod-eddsa] -lookahead_sign = "1 year" -overlap_duration = "1 year" - -[coin_kudo_1] -value= EUR:0.01 -duration_withdraw= "1 year" -duration_spend= "1 year" -duration_legal= "1 year" -fee_withdraw= EUR:0.00 -fee_deposit= EUR:0.00 -fee_refresh= EUR:0.00 -fee_refund= EUR:0.00 -cipher= RSA -rsa_keysize= 2048 -age_restricted= NO - -[coin_kudo_2] -value= EUR:0.02 -duration_withdraw= "1 year" -duration_spend= "1 year" -duration_legal= "1 year" -fee_withdraw= EUR:0.00 -fee_deposit= EUR:0.00 -fee_refresh= EUR:0.00 -fee_refund= EUR:0.00 -cipher= RSA -rsa_keysize= 2048 -age_restricted= NO diff --git a/.jjconflict-side-0/data/assets/privacy/en/0.md b/.jjconflict-side-0/data/assets/privacy/en/0.md deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-0/data/assets/privacy/en/0.md +++ /dev/null @@ -1 +0,0 @@ -# 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 deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-0/data/assets/privacy/en/0.txt +++ /dev/null @@ -1 +0,0 @@ -# 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 deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-0/data/assets/terms/en/0.md +++ /dev/null @@ -1 +0,0 @@ -# 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 deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-0/data/assets/terms/en/0.txt +++ /dev/null @@ -1 +0,0 @@ -# TODO dummy ToS diff --git a/.jjconflict-side-0/data/auditor_private_key b/.jjconflict-side-0/data/auditor_private_key deleted file mode 100644 index 82aad694..00000000 --- a/.jjconflict-side-0/data/auditor_private_key +++ /dev/null @@ -1 +0,0 @@ -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 deleted file mode 100644 index 4b97fccf..00000000 --- a/.jjconflict-side-0/data/auditor_public_key +++ /dev/null @@ -1 +0,0 @@ -A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0 diff --git a/.jjconflict-side-0/data/master_offline_private_key b/.jjconflict-side-0/data/master_offline_private_key deleted file mode 100644 index 739df00753dec0a45457613e2fa155040b7b1640..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 32 ocmeBTT_Rt)l0mH8LojFl=5=BInT@*|pKCD8z4+JNTQJuH0MexmUjP6A diff --git a/.jjconflict-side-0/data/secmod/.gitkeep b/.jjconflict-side-0/data/secmod/.gitkeep deleted file mode 100644 index e69de29b..00000000 diff --git a/.jjconflict-side-0/dune-project b/.jjconflict-side-0/dune-project deleted file mode 100644 index 5bd4e1f1..00000000 --- a/.jjconflict-side-0/dune-project +++ /dev/null @@ -1,46 +0,0 @@ -(lang dune 3.20) - -(name mte) - -(generate_opam_files true) - -; (source -; (github username/reponame)) - -(authors "Olivier Pierre ") - -(maintainers "Olivier Pierre ") - -(license AGPL-3.0-only) - -; (documentation https://url/to/documentation) - -(package - (name mte) - (synopsis "MTE - the MirageOS Taler Exchange") - (description "A GNU Taler exchange implementation with the unikernel framework MirageOS") - (tags - ("GNU Taler" MirageOS unikernel OCaml crypto)) - (depends - (ocaml (>= 5.3)) - base32 - caqti - caqti-miou - caqti-driver-pgx - crunch - vif - jsont - cohttp - fmt - bin - angstrom - 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 deleted file mode 100644 index 3418869c..00000000 --- a/.jjconflict-side-0/include/dune +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index d9211977..00000000 --- a/.jjconflict-side-0/include/taler_signatures.ml +++ /dev/null @@ -1,78 +0,0 @@ -(* 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 deleted file mode 100644 index 8bdbc121..00000000 --- a/.jjconflict-side-0/mte.opam +++ /dev/null @@ -1,49 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "MTE - the MirageOS Taler Exchange" -description: - "A GNU Taler exchange implementation with the unikernel framework MirageOS" -maintainer: ["Olivier Pierre "] -authors: ["Olivier Pierre "] -license: "AGPL-3.0-only" -tags: ["GNU Taler" "MirageOS" "unikernel" "OCaml" "crypto"] -depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "5.3"} - "base32" - "caqti" - "caqti-miou" - "caqti-driver-pgx" - "crunch" - "vif" - "jsont" - "cohttp" - "fmt" - "bin" - "angstrom" - "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 deleted file mode 100644 index 65fde44d..00000000 --- a/.jjconflict-side-0/src/amount.ml +++ /dev/null @@ -1,121 +0,0 @@ -(* 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 deleted file mode 100644 index 920bed18..00000000 --- a/.jjconflict-side-0/src/amount.mli +++ /dev/null @@ -1,34 +0,0 @@ -(* 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 deleted file mode 100644 index 519cfb38..00000000 --- a/.jjconflict-side-0/src/api.ml +++ /dev/null @@ -1,1347 +0,0 @@ -(* 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 deleted file mode 100644 index 9d6c8088..00000000 --- a/.jjconflict-side-0/src/assets.ml +++ /dev/null @@ -1,150 +0,0 @@ -(* 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 deleted file mode 100644 index 6bd06400..00000000 --- a/.jjconflict-side-0/src/b32.ml +++ /dev/null @@ -1,38 +0,0 @@ -(* Crockford's variant of Base32 - http://www.crockford.com/wrmg/base32.html - except that: - - 'U' is not excluded but also decodes to 'V' - - '-' is not allowed - - checksum is not allowed *) - -(* 'I' 'L' 'O' 'U' excluded - no '=' padding in encoded string *) -type t = string - -let alphabet = Base32.make_alphabet "0123456789ABCDEFGHJKMNPQRSTVWXYZ" - -let encode s = - let s = Base32.encode_string ~alphabet s in - (* remove '=' padding *) - match String.index_opt s '=' with - | None -> s - | Some i -> String.sub s 0 i - -let decode s = - let s = - String.map - (fun c -> - match Char.uppercase_ascii c with - | 'O' -> '0' - | 'I' | 'L' -> '1' - | 'U' -> 'V' - | c -> c) - s - in - (* restore padding for base32 lib *) - let n = 8 - (String.length s mod 8) in - let pad = String.make n '=' in - let s = s ^ pad in - match Base32.decode ~alphabet ~off:0 ~len:(String.length s) s with - | Error (`Msg e) -> Error e - | Ok v -> Ok v diff --git a/.jjconflict-side-0/src/config.ml b/.jjconflict-side-0/src/config.ml deleted file mode 100644 index 9be285c0..00000000 --- a/.jjconflict-side-0/src/config.ml +++ /dev/null @@ -1,200 +0,0 @@ -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 deleted file mode 100644 index bf437fce..00000000 --- a/.jjconflict-side-0/src/crypto.ml +++ /dev/null @@ -1,300 +0,0 @@ -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 deleted file mode 100644 index 9fa34674..00000000 --- a/.jjconflict-side-0/src/data_file.ml +++ /dev/null @@ -1,35 +0,0 @@ -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 deleted file mode 100644 index 7d94367d..00000000 --- a/.jjconflict-side-0/src/denom_data.ml +++ /dev/null @@ -1,18 +0,0 @@ -open Crypto - -type t = { - pub: rsa_pub; - value: Amount.t; - stamp_start: Timestamp.t; - stamp_expire_withdraw: Timestamp.t; - stamp_expire_deposit: Timestamp.t; - stamp_expire_legal: Timestamp.t; - fee_withdraw: Amount.t; - fee_deposit: Amount.t; - fee_refresh: Amount.t; - fee_refund: Amount.t; - age_mask: int; - h_pub: 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 deleted file mode 100644 index 7da26428..00000000 --- a/.jjconflict-side-0/src/devices.ml +++ /dev/null @@ -1,26 +0,0 @@ -type env = { - caqti_switch: Caqti_miou.Switch.t; - db_uri: Uri.t; -} - -let db_connection : (env, Caqti_miou.connection) Vif.Device.device = - let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in - Vif.Device.v ~name:"db_connection" ~finally [] - @@ fun { caqti_switch; db_uri } -> - match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with - | Error err -> - Fmt.failwith "Database connection failure: %a." Caqti_error.pp err - | Ok conn -> ( - match Pg.preflight conn with - | Error err -> - Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err - | Ok () -> - Logs.info (fun m -> m "database connection initialized"); - conn) - -let 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 deleted file mode 100644 index 2a1a266a..00000000 --- a/.jjconflict-side-0/src/dune +++ /dev/null @@ -1,45 +0,0 @@ -(executable - (public_name mte) - (name mte) - (modules mte) - (libraries mte)) - -(library - (name mte) - (wrapped false) - (modules :standard \ mte b32) - (libraries - b32 - 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 deleted file mode 100644 index ca32519f..00000000 --- a/.jjconflict-side-0/src/hash.ml +++ /dev/null @@ -1,108 +0,0 @@ -open Digestif - -module type S = sig - type t - - val bin : t Bin.t - val caqti : t Caqti_type.t - val jsont : t Jsont.t - val hash : string -> t - val of_octets : string -> t - val to_octets : t -> string - val of_b32 : B32.t -> (t, string) result -end - -module H32 = struct - type t = SHA256.t - - let hash s = SHA256.(digest_string s) - - let of_octets s = - match 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 deleted file mode 100644 index ae740b4f..00000000 --- a/.jjconflict-side-0/src/headers.ml +++ /dev/null @@ -1,52 +0,0 @@ -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 accept = Vif.Headers.get headers "accept" in - Cohttp.Accept.media_ranges accept - |> 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 - |> 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 = - Vif.Headers.get headers "accept-encoding" - |> Cohttp.Accept.encodings - |> 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 deleted file mode 100644 index b26f5da1..00000000 --- a/.jjconflict-side-0/src/headers_lib.ml +++ /dev/null @@ -1,86 +0,0 @@ -(* 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 deleted file mode 100644 index 0fd92a81..00000000 --- a/.jjconflict-side-0/src/http_keys.ml +++ /dev/null @@ -1,262 +0,0 @@ -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 = - Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti - in - let* auditors = - (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) - (* does not contains auditor_keys with empty denomination_keys *) - Pg.get_auditor_keys db_conn - in - let extensions = None in - let extensions_sig = None in - Ok - ExchangeKeysResponse. - { - version; - base_url; - currency; - shopping_url; - open_banking_gateway; - bank_compliance_language; - currency_specification; - tiny_amount; - stefan_abs; - stefan_log; - stefan_lin; - asset_type; - accounts; - wire_fees; - wads; - rewards_allowed; - kyc_enabled; - disable_direct_deposit; - master_public_key; - reserve_closing_delay; - wallet_balance_limit_without_kyc; - hard_limits; - zero_limits; - denominations; - exchange_sig; - exchange_pub; - recoup; - global_fees; - list_issue_date; - auditors; - signkeys; - extensions; - extensions_sig; - } - -let jsont = ExchangeKeysResponse.jsont - -(* 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 deleted file mode 100644 index 61cb5e5e..00000000 --- a/.jjconflict-side-0/src/http_management.ml +++ /dev/null @@ -1,749 +0,0 @@ -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; - 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 deleted file mode 100644 index f98ee88f..00000000 --- a/.jjconflict-side-0/src/mte.ml +++ /dev/null @@ -1,77 +0,0 @@ -(* MTE - the MirageOS Taler Exchange - Copyright (C) 2025 Olivier Pierre - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Affero General Public License as published by - the Free Software Foundation, version 3. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Affero General Public License for more details. - - You should have received a copy of the GNU Affero General Public License - along with this program. If not, see . *) - -let hello req _server _env = - let open Vif.Response in - let open Syntax in - let* () = with_string req "Hello~~\n" in - let* () = add ~field:"content-type" "text/plain" in - respond `OK - -let routes = - let open Vif.Uri in - let open Vif.Route in - let get_ path = get (path /?? any) in - let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in - let 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 deleted file mode 100644 index cd2c141a..00000000 --- a/.jjconflict-side-0/src/parse_config.ml +++ /dev/null @@ -1,262 +0,0 @@ -(* 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 deleted file mode 100644 index 32428045..00000000 --- a/.jjconflict-side-0/src/pg.ml +++ /dev/null @@ -1,374 +0,0 @@ -(* 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 deleted file mode 100644 index 0a2e8f15..00000000 --- a/.jjconflict-side-0/src/pg_type.ml +++ /dev/null @@ -1,377 +0,0 @@ -(* 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 deleted file mode 100644 index 3c4faf5d..00000000 --- a/.jjconflict-side-0/src/respond_util.ml +++ /dev/null @@ -1,22 +0,0 @@ -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 deleted file mode 100644 index ed74310f..00000000 --- a/.jjconflict-side-0/src/secmod.ml +++ /dev/null @@ -1,407 +0,0 @@ -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 deleted file mode 100644 index 0205b866..00000000 --- a/.jjconflict-side-0/src/secmod.mli +++ /dev/null @@ -1,46 +0,0 @@ -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 deleted file mode 100644 index 6a6b67ce..00000000 --- a/.jjconflict-side-0/src/signatures.ml +++ /dev/null @@ -1,1308 +0,0 @@ -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; - 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 - denom_hash - -> - { - master; - start; - expire_withdraw; - expire_spend; - expire_legal; - value; - fee_withdraw; - fee_deposit; - fee_refresh; - 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 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 deleted file mode 100644 index 22a7a0cd..00000000 --- a/.jjconflict-side-0/src/signkey_data.ml +++ /dev/null @@ -1,10 +0,0 @@ -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 deleted file mode 100644 index 57b24dcd..00000000 --- a/.jjconflict-side-0/src/static.ml +++ /dev/null @@ -1,84 +0,0 @@ -(* 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 - s - end - - let bad_request ?hint req = - let body = error_detail ?hint `Bad_request 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* () = with_string ?compression:None req body in - let* () = add ~field:"accept" Headers.accept_header_value 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 -> Respond_with.bad_request ~hint:e req - | Ok true -> Respond_with.not_modified () - | Ok false -> ( - match Headers.select_mimetype headers with - | None -> 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) - -let terms req _server _env = aux Assets.Terms req _server _env -let privacy req _server _env = aux Assets.Privacy req _server _env diff --git a/.jjconflict-side-0/src/syntax.ml b/.jjconflict-side-0/src/syntax.ml deleted file mode 100644 index c61aba15..00000000 --- a/.jjconflict-side-0/src/syntax.ml +++ /dev/null @@ -1,51 +0,0 @@ -let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e -let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e - -(* TODO use polymorphic variant for errors *) -let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v - -let unwrap_err_caqti o = - match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v - -let list_iter f l = - let err = ref None in - try - List.iter - (fun v -> - match f v with - | Error _e as e -> - err := Some e; - raise Exit - | Ok () -> ()) - l; - Ok () - with Exit -> ( match !err with None -> assert false | Some v -> v) - -let list_map f l = - let err = ref None in - try - Ok - (List.map - (fun v -> - match f v with - | Error _e as e -> - err := Some e; - raise Exit - | Ok v -> v) - l) - with Exit -> ( match !err with None -> assert false | Some v -> v) - -let list_fold_left f acc l = - List.fold_left - (fun acc v -> - let* acc = acc in - f acc v) - (Ok acc) l - -let opt_list l = - match (List.for_all Option.is_none l, List.for_all Option.is_some l) with - | _, true -> - let l = List.map Option.get l in - Ok (Some l) - | true, _ -> Ok None - | _, _ -> Error () diff --git a/.jjconflict-side-0/src/time.ml b/.jjconflict-side-0/src/time.ml deleted file mode 100644 index 3c5af371..00000000 --- a/.jjconflict-side-0/src/time.ml +++ /dev/null @@ -1,151 +0,0 @@ -let uint64_max = Int64.minus_one - -module Relative = struct - type t = Int64.t - - let forever = uint64_max - let zero = 0L - let compare = Int64.unsigned_compare - let min a b = if compare a b < 0 then a else b - let max a b = if compare a b > 0 then a else b - - (* forever if either argument is forever or on overflow; otherwise a + b *) - let add a b = - if a = forever || b = forever then forever - else - let v = Int64.add a b in - if compare v a < 0 then forever else v - - (* zero if a <= b, or forever if a is forever; otherwise a - b *) - let sub a b = - if compare a b <= 0 then zero - else if a = forever then forever - else Int64.sub a b - - let of_s s = - let v = Int64.mul s 1_000_000L in - if Int64.unsigned_div v 1_000_000L <> s then forever else v - - let bin = Bin.neint64 - let bin_nbo = Bin.beint64 - - (* TODO should be in NBO here? *) - let caqti = - let encode v = Ok v in - let decode v = Ok v in - Caqti_type.custom ~encode ~decode Caqti_type.int64 - - (* TODO - reject negative / non-integer values - cap value at 2^53 - 1 inclusive *) - let jsont = - let jsont = - let forever_jsont = - let dec s = - match s with - | "forever" -> forever - | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" - in - let enc _t = "forever" in - Jsont.map ~dec ~enc Jsont.string - in - let num_jsont = Jsont.int64 in - let enc t = if t = forever then forever_jsont else num_jsont in - Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc () - in - Jsont.Object.map ~kind:"RelativeTime" Fun.id - |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id - |> Jsont.Object.finish -end - -module Absolute = struct - type t = Int64.t - - let never = uint64_max - let zero = 0L - let compare = Int64.unsigned_compare - let min a b = if compare a b < 0 then a else b - let max a b = if compare a b > 0 then a else b - - (* zero if a >= b; never if b=never; otherwise b - a *) - let diff a b = - if compare a b >= 0 then zero - else if b = never then never - else Int64.sub b a - - (* never if either argument is never/forever or on overflow; otherwise t + d *) - let add t d = - if t = never || d = never then never - else - let v = Int64.add t d in - if compare v t < 0 then never else v - - (* zero if t <= d, or never if t is never; otherwise t - d *) - let sub t d = - if compare t d <= 0 then zero - else if t = never then never - else Int64.sub t d - - let of_s s = - let v = Int64.mul s 1_000_000L in - if Int64.unsigned_div v 1_000_000L <> s then never else v - - let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s -end - -module Timestamp = struct - type t = Int64.t - - let never = uint64_max - let zero = 0L - let compare = Int64.unsigned_compare - - (* zero if a >= b; never if b=never; otherwise b - a *) - let diff a b = - if compare a b >= 0 then zero - else if b = never then never - else Int64.sub b a - - let of_s s = - let v = Int64.mul s 1_000_000L in - if Int64.unsigned_div v 1_000_000L <> s then never else v - - let to_s t = - if t = never then None else Some (Int64.unsigned_div t 1_000_000L) - - let of_absolute a = - if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L) - - let of_ptime v = v |> Absolute.of_ptime |> of_absolute - let bin = Bin.neint64 - let bin_nbo = Bin.beint64 - - let caqti = - let encode v = Ok v in - let decode v = Ok v in - Caqti_type.custom ~encode ~decode Caqti_type.int64 - - let jsont = - let jsont = - let never_jsont = - let dec s = - match s with - | "never" -> never - | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" - in - let enc _t = "never" in - Jsont.map ~dec ~enc Jsont.string - in - let num_jsont = - Jsont.map - ~dec:(fun n -> of_s n) - ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s) - Jsont.int64 - in - let enc t = if t = never then never_jsont else num_jsont in - Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc () - in - Jsont.Object.map ~kind:"Timestamp" Fun.id - |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id - |> Jsont.Object.finish -end diff --git a/.jjconflict-side-0/src/time.mli b/.jjconflict-side-0/src/time.mli deleted file mode 100644 index 180df904..00000000 --- a/.jjconflict-side-0/src/time.mli +++ /dev/null @@ -1,54 +0,0 @@ -module Relative : sig - type t - - val forever : t - val zero : t - val compare : t -> t -> int - val min : t -> t -> t - val max : t -> t -> t - val add : t -> t -> t - val sub : t -> t -> t - val of_s : int64 -> t - - (* - *) - val bin : t Bin.t - val bin_nbo : t Bin.t - val caqti : t Caqti_type.t - val jsont : t Jsont.t -end - -module Absolute : sig - type t - - val never : t - val zero : t - val compare : t -> t -> int - val min : t -> t -> t - val max : t -> t -> t - val diff : t -> t -> Relative.t - val add : t -> Relative.t -> t - val sub : t -> Relative.t -> t - val of_s : int64 -> t - val of_ptime : Ptime.t -> t -end - -module Timestamp : sig - type t - - val never : t - val zero : t - val compare : t -> t -> int - val diff : t -> t -> Relative.t - val of_s : int64 -> t - - (* none if t = never *) - val to_s : t -> int64 option - val of_absolute : Absolute.t -> t - val of_ptime : Ptime.t -> t - - (* - *) - val bin : t Bin.t - val bin_nbo : t Bin.t - val caqti : t Caqti_type.t - val jsont : t Jsont.t -end diff --git a/.jjconflict-side-0/src/timestamp.ml b/.jjconflict-side-0/src/timestamp.ml deleted file mode 100644 index 1a942758..00000000 --- a/.jjconflict-side-0/src/timestamp.ml +++ /dev/null @@ -1 +0,0 @@ -include Time.Timestamp diff --git a/.jjconflict-side-0/src/util.ml b/.jjconflict-side-0/src/util.ml deleted file mode 100644 index c690a009..00000000 --- a/.jjconflict-side-0/src/util.ml +++ /dev/null @@ -1,62 +0,0 @@ -module Log_reporter = struct - let detail_tag : string Logs.Tag.def = - Logs.Tag.def "Detail tag" ~doc:"" Fmt.string - - let detail s = Logs.Tag.(empty |> add detail_tag s) - let time_anchor = Ptime_clock.now () |> Ptime.to_span - - let color_of_log_level = function - | Logs.App -> `White - | Error -> `Red - | Warning -> `Yellow - | Info -> `Blue - | Debug -> `Magenta - - let reporter : Logs.reporter = - let open Fmt in - let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%04.02f")) in - let pp_header ppf v = - let color = color_of_log_level (fst v) in - let pp = styled (`Fg color) Logs.pp_header in - pf ppf "%a" pp v - in - let pp_src_name = - let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in - fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v - in - let pp_detail = option (styled `Green (fmt " (%s)")) in - let report src lvl ~over k msgf = - let ppf = - match lvl with - | Logs.App -> stdout - | Error | Warning | Info | Debug -> stderr - in - let k _ppf = over (); k () in - let with_detail h tags k user_fmt = - let detail = Option.bind tags (Logs.Tag.find detail_tag) in - let timestamp = - Ptime.sub_span (Ptime_clock.now ()) time_anchor - |> Option.map Ptime.to_float_s - |> Option.value ~default:0. - in - let k ppf = kpf k ppf "%a@." pp_detail detail in - let k ppf = kpf k ppf user_fmt in - kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h) - pp_src_name src - in - msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt - in - { report } - - (* TODO logs - - vif shouldn't use/set the default reporter - - Log.err all `Internal_server_error response *) - let setup () = - let level = Some Logs.Info in - Logs.set_level ~all:false level; - Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true (); - Logs.Src.set_level Logs.default level; - Logs_threaded.enable (); - Logs.set_reporter reporter; - () -end diff --git a/.jjconflict-side-0/test/dune b/.jjconflict-side-0/test/dune deleted file mode 100644 index 1eefa8ef..00000000 --- a/.jjconflict-side-0/test/dune +++ /dev/null @@ -1,11 +0,0 @@ -(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 deleted file mode 100755 index a4999491..00000000 --- a/.jjconflict-side-0/test/offline_management.sh +++ /dev/null @@ -1,45 +0,0 @@ -#!/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 deleted file mode 100644 index bcebe993..00000000 --- a/.jjconflict-side-0/test/signatures.c +++ /dev/null @@ -1,55 +0,0 @@ -#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 deleted file mode 100644 index 03831efc..00000000 --- a/.jjconflict-side-0/test/test.ml +++ /dev/null @@ -1,110 +0,0 @@ -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/.jjconflict-side-0/tools/dune b/.jjconflict-side-0/tools/dune deleted file mode 100644 index f500902e..00000000 --- a/.jjconflict-side-0/tools/dune +++ /dev/null @@ -1,7 +0,0 @@ -(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 deleted file mode 100644 index f40664fd..00000000 --- a/.jjconflict-side-0/tools/offline.ml +++ /dev/null @@ -1,313 +0,0 @@ -(* 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 deleted file mode 100644 index 3438ec66..00000000 --- a/.jjconflict-side-0/tools/offline_impl.ml +++ /dev/null @@ -1,230 +0,0 @@ -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 deleted file mode 100644 index 94675300..00000000 --- a/.jjconflict-side-0/tools/offline_sig.ml +++ /dev/null @@ -1,146 +0,0 @@ -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; - 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 deleted file mode 100644 index dbd4866f..00000000 --- a/.jjconflict-side-1/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -_build -data/secmod/* -!data/secmod/.gitkeep diff --git a/.jjconflict-side-1/.ocamlformat b/.jjconflict-side-1/.ocamlformat deleted file mode 100644 index 43b12fc0..00000000 --- a/.jjconflict-side-1/.ocamlformat +++ /dev/null @@ -1,15 +0,0 @@ -version=0.28.1 -exp-grouping=preserve -type-decl=sparse -break-infix=fit-or-vertical -break-collection-expressions=fit-or-vertical -break-sequences=false -break-infix-before-func=false -dock-collection-brackets=true -break-separators=after -field-space=tight -if-then-else=compact -break-sequences=false -sequence-blank-line=compact -exp-grouping=preserve -sequence-blank-line=preserve-one diff --git a/.jjconflict-side-1/LICENSE b/.jjconflict-side-1/LICENSE deleted file mode 100644 index be3f7b28..00000000 --- a/.jjconflict-side-1/LICENSE +++ /dev/null @@ -1,661 +0,0 @@ - GNU AFFERO GENERAL PUBLIC LICENSE - Version 3, 19 November 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU Affero General Public License is a free, copyleft license for -software and other kinds of works, specifically designed to ensure -cooperation with the community in the case of network server software. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -our General Public Licenses are intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - Developers that use our General Public Licenses protect your rights -with two steps: (1) assert copyright on the software, and (2) offer -you this License which gives you legal permission to copy, distribute -and/or modify the software. - - A secondary benefit of defending all users' freedom is that -improvements made in alternate versions of the program, if they -receive widespread use, become available for other developers to -incorporate. Many developers of free software are heartened and -encouraged by the resulting cooperation. However, in the case of -software used on network servers, this result may fail to come about. -The GNU General Public License permits making a modified version and -letting the public access it on a server without ever releasing its -source code to the public. - - The GNU Affero General Public License is designed specifically to -ensure that, in such cases, the modified source code becomes available -to the community. It requires the operator of a network server to -provide the source code of the modified version running there to the -users of that server. Therefore, public use of a modified version, on -a publicly accessible server, gives the public access to the source -code of the modified version. - - An older license, called the Affero General Public License and -published by Affero, was designed to accomplish similar goals. This is -a different license, not a version of the Affero GPL, but Affero has -released a new version of the Affero GPL which permits relicensing under -this license. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU Affero General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Remote Network Interaction; Use with the GNU General Public License. - - Notwithstanding any other provision of this License, if you modify the -Program, your modified version must prominently offer all users -interacting with it remotely through a computer network (if your version -supports such interaction) an opportunity to receive the Corresponding -Source of your version by providing access to the Corresponding Source -from a network server at no charge, through some standard or customary -means of facilitating copying of software. This Corresponding Source -shall include the Corresponding Source for any work covered by version 3 -of the GNU General Public License that is incorporated pursuant to the -following paragraph. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the work with which it is combined will remain governed by version -3 of the GNU General Public License. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU Affero General Public License from time to time. Such new versions -will be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU Affero General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU Affero General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU Affero General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Affero General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Affero General Public License for more details. - - You should have received a copy of the GNU Affero General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If your software can interact with users remotely through a computer -network, you should also make sure that it provides a way for users to -get its source. For example, if your program is a web application, its -interface could display a "Source" link that leads users to an archive -of the code. There are many ways you could offer source, and different -solutions will be better for different programs; see section 13 for the -specific requirements. - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU AGPL, see -. diff --git a/.jjconflict-side-1/data/assets/default.config b/.jjconflict-side-1/data/assets/default.config deleted file mode 100644 index a6c89c52..00000000 --- a/.jjconflict-side-1/data/assets/default.config +++ /dev/null @@ -1,74 +0,0 @@ -[currency-EUR] -enabled= YES -code= EUR -name= euro -fractional_input_digits= 2 -fractional_normal_digits= 2 -fractional_trailing_zero_digits= 2 -alt_unit_names= "{"0":"€","3":"k€"}" - -[exchange] -currency = EUR -currency_round_unit = EUR:0.01 -db = postgres -attribute_encryption_key = "deadbeef" -port = 3434 -bind_to = localhost -master_public_key = "SJ0NYND22VQP3MP7FM754RDX8HCKVWAXTHY9SQNBTPRJZ2SPM2S0" -stefan_abs = EUR:0.00 -stefan_log = EUR:0.00 -stefan_lin = 0.00 -aggregator_idle_sleep_interval = "1 hour" -closer_idle_sleep_interval = "1 hour" -transfer_idle_sleep_interval = "1 hour" -wirewatch_idle_sleep_interval = "1 hour" -signkey_legal_duration = "1 year" -max_keys_caching = "4 weeks" -enable_kyc = NO -terms_etag = "0" -privacy_etag = "0" -base_url = "http://localhost:3434/" - -[exchangedb] -idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds" -legal_reserve_expiration_time = "1 year" -aggregator_shift = "1 year" -max_aml_program_runtime = "1 year" -default_purse_limit = 9999 - -[exchangedb-postgres] -config = "pgx://mte:hunter2@localhost:5432/taler-exchange" - -[taler-exchange-secmod-rsa] -lookahead_sign = "1 year" -overlap_duration = "1 year" - -[taler-exchange-secmod-eddsa] -lookahead_sign = "1 year" -overlap_duration = "1 year" - -[coin_kudo_1] -value= EUR:0.01 -duration_withdraw= "1 year" -duration_spend= "1 year" -duration_legal= "1 year" -fee_withdraw= EUR:0.00 -fee_deposit= EUR:0.00 -fee_refresh= EUR:0.00 -fee_refund= EUR:0.00 -cipher= RSA -rsa_keysize= 2048 -age_restricted= NO - -[coin_kudo_2] -value= EUR:0.02 -duration_withdraw= "1 year" -duration_spend= "1 year" -duration_legal= "1 year" -fee_withdraw= EUR:0.00 -fee_deposit= EUR:0.00 -fee_refresh= EUR:0.00 -fee_refund= EUR:0.00 -cipher= RSA -rsa_keysize= 2048 -age_restricted= NO diff --git a/.jjconflict-side-1/data/assets/privacy/en/0.md b/.jjconflict-side-1/data/assets/privacy/en/0.md deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-1/data/assets/privacy/en/0.md +++ /dev/null @@ -1 +0,0 @@ -# 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 deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-1/data/assets/privacy/en/0.txt +++ /dev/null @@ -1 +0,0 @@ -# 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 deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-1/data/assets/terms/en/0.md +++ /dev/null @@ -1 +0,0 @@ -# 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 deleted file mode 100644 index 419e12ef..00000000 --- a/.jjconflict-side-1/data/assets/terms/en/0.txt +++ /dev/null @@ -1 +0,0 @@ -# TODO dummy ToS diff --git a/.jjconflict-side-1/data/auditor_private_key b/.jjconflict-side-1/data/auditor_private_key deleted file mode 100644 index 82aad694..00000000 --- a/.jjconflict-side-1/data/auditor_private_key +++ /dev/null @@ -1 +0,0 @@ -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 deleted file mode 100644 index 4b97fccf..00000000 --- a/.jjconflict-side-1/data/auditor_public_key +++ /dev/null @@ -1 +0,0 @@ -A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0 diff --git a/.jjconflict-side-1/data/master_offline_private_key b/.jjconflict-side-1/data/master_offline_private_key deleted file mode 100644 index 739df00753dec0a45457613e2fa155040b7b1640..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 32 ocmeBTT_Rt)l0mH8LojFl=5=BInT@*|pKCD8z4+JNTQJuH0MexmUjP6A diff --git a/.jjconflict-side-1/data/secmod/.gitkeep b/.jjconflict-side-1/data/secmod/.gitkeep deleted file mode 100644 index e69de29b..00000000 diff --git a/.jjconflict-side-1/dune-project b/.jjconflict-side-1/dune-project deleted file mode 100644 index 5bd4e1f1..00000000 --- a/.jjconflict-side-1/dune-project +++ /dev/null @@ -1,46 +0,0 @@ -(lang dune 3.20) - -(name mte) - -(generate_opam_files true) - -; (source -; (github username/reponame)) - -(authors "Olivier Pierre ") - -(maintainers "Olivier Pierre ") - -(license AGPL-3.0-only) - -; (documentation https://url/to/documentation) - -(package - (name mte) - (synopsis "MTE - the MirageOS Taler Exchange") - (description "A GNU Taler exchange implementation with the unikernel framework MirageOS") - (tags - ("GNU Taler" MirageOS unikernel OCaml crypto)) - (depends - (ocaml (>= 5.3)) - base32 - caqti - caqti-miou - caqti-driver-pgx - crunch - vif - jsont - cohttp - fmt - bin - angstrom - 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 deleted file mode 100644 index 3418869c..00000000 --- a/.jjconflict-side-1/include/dune +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index d9211977..00000000 --- a/.jjconflict-side-1/include/taler_signatures.ml +++ /dev/null @@ -1,78 +0,0 @@ -(* 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 deleted file mode 100644 index 8bdbc121..00000000 --- a/.jjconflict-side-1/mte.opam +++ /dev/null @@ -1,49 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "MTE - the MirageOS Taler Exchange" -description: - "A GNU Taler exchange implementation with the unikernel framework MirageOS" -maintainer: ["Olivier Pierre "] -authors: ["Olivier Pierre "] -license: "AGPL-3.0-only" -tags: ["GNU Taler" "MirageOS" "unikernel" "OCaml" "crypto"] -depends: [ - "dune" {>= "3.20"} - "ocaml" {>= "5.3"} - "base32" - "caqti" - "caqti-miou" - "caqti-driver-pgx" - "crunch" - "vif" - "jsont" - "cohttp" - "fmt" - "bin" - "angstrom" - "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 deleted file mode 100644 index 65fde44d..00000000 --- a/.jjconflict-side-1/src/amount.ml +++ /dev/null @@ -1,121 +0,0 @@ -(* 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 deleted file mode 100644 index 920bed18..00000000 --- a/.jjconflict-side-1/src/amount.mli +++ /dev/null @@ -1,34 +0,0 @@ -(* 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 deleted file mode 100644 index 519cfb38..00000000 --- a/.jjconflict-side-1/src/api.ml +++ /dev/null @@ -1,1347 +0,0 @@ -(* 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 deleted file mode 100644 index 9d6c8088..00000000 --- a/.jjconflict-side-1/src/assets.ml +++ /dev/null @@ -1,150 +0,0 @@ -(* 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 deleted file mode 100644 index 6bd06400..00000000 --- a/.jjconflict-side-1/src/b32.ml +++ /dev/null @@ -1,38 +0,0 @@ -(* Crockford's variant of Base32 - http://www.crockford.com/wrmg/base32.html - except that: - - 'U' is not excluded but also decodes to 'V' - - '-' is not allowed - - checksum is not allowed *) - -(* 'I' 'L' 'O' 'U' excluded - no '=' padding in encoded string *) -type t = string - -let alphabet = Base32.make_alphabet "0123456789ABCDEFGHJKMNPQRSTVWXYZ" - -let encode s = - let s = Base32.encode_string ~alphabet s in - (* remove '=' padding *) - match String.index_opt s '=' with - | None -> s - | Some i -> String.sub s 0 i - -let decode s = - let s = - String.map - (fun c -> - match Char.uppercase_ascii c with - | 'O' -> '0' - | 'I' | 'L' -> '1' - | 'U' -> 'V' - | c -> c) - s - in - (* restore padding for base32 lib *) - let n = 8 - (String.length s mod 8) in - let pad = String.make n '=' in - let s = s ^ pad in - match Base32.decode ~alphabet ~off:0 ~len:(String.length s) s with - | Error (`Msg e) -> Error e - | Ok v -> Ok v diff --git a/.jjconflict-side-1/src/config.ml b/.jjconflict-side-1/src/config.ml deleted file mode 100644 index 9be285c0..00000000 --- a/.jjconflict-side-1/src/config.ml +++ /dev/null @@ -1,200 +0,0 @@ -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 deleted file mode 100644 index bf437fce..00000000 --- a/.jjconflict-side-1/src/crypto.ml +++ /dev/null @@ -1,300 +0,0 @@ -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 deleted file mode 100644 index 9fa34674..00000000 --- a/.jjconflict-side-1/src/data_file.ml +++ /dev/null @@ -1,35 +0,0 @@ -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 deleted file mode 100644 index 7d94367d..00000000 --- a/.jjconflict-side-1/src/denom_data.ml +++ /dev/null @@ -1,18 +0,0 @@ -open Crypto - -type t = { - pub: rsa_pub; - value: Amount.t; - stamp_start: Timestamp.t; - stamp_expire_withdraw: Timestamp.t; - stamp_expire_deposit: Timestamp.t; - stamp_expire_legal: Timestamp.t; - fee_withdraw: Amount.t; - fee_deposit: Amount.t; - fee_refresh: Amount.t; - fee_refund: Amount.t; - age_mask: int; - h_pub: 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 deleted file mode 100644 index 7da26428..00000000 --- a/.jjconflict-side-1/src/devices.ml +++ /dev/null @@ -1,26 +0,0 @@ -type env = { - caqti_switch: Caqti_miou.Switch.t; - db_uri: Uri.t; -} - -let db_connection : (env, Caqti_miou.connection) Vif.Device.device = - let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in - Vif.Device.v ~name:"db_connection" ~finally [] - @@ fun { caqti_switch; db_uri } -> - match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with - | Error err -> - Fmt.failwith "Database connection failure: %a." Caqti_error.pp err - | Ok conn -> ( - match Pg.preflight conn with - | Error err -> - Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err - | Ok () -> - Logs.info (fun m -> m "database connection initialized"); - conn) - -let 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 deleted file mode 100644 index 2a1a266a..00000000 --- a/.jjconflict-side-1/src/dune +++ /dev/null @@ -1,45 +0,0 @@ -(executable - (public_name mte) - (name mte) - (modules mte) - (libraries mte)) - -(library - (name mte) - (wrapped false) - (modules :standard \ mte b32) - (libraries - b32 - 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 deleted file mode 100644 index ca32519f..00000000 --- a/.jjconflict-side-1/src/hash.ml +++ /dev/null @@ -1,108 +0,0 @@ -open Digestif - -module type S = sig - type t - - val bin : t Bin.t - val caqti : t Caqti_type.t - val jsont : t Jsont.t - val hash : string -> t - val of_octets : string -> t - val to_octets : t -> string - val of_b32 : B32.t -> (t, string) result -end - -module H32 = struct - type t = SHA256.t - - let hash s = SHA256.(digest_string s) - - let of_octets s = - match 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 deleted file mode 100644 index ae740b4f..00000000 --- a/.jjconflict-side-1/src/headers.ml +++ /dev/null @@ -1,52 +0,0 @@ -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 accept = Vif.Headers.get headers "accept" in - Cohttp.Accept.media_ranges accept - |> 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 - |> 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 = - Vif.Headers.get headers "accept-encoding" - |> Cohttp.Accept.encodings - |> 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 deleted file mode 100644 index b26f5da1..00000000 --- a/.jjconflict-side-1/src/headers_lib.ml +++ /dev/null @@ -1,86 +0,0 @@ -(* 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 deleted file mode 100644 index 0fd92a81..00000000 --- a/.jjconflict-side-1/src/http_keys.ml +++ /dev/null @@ -1,262 +0,0 @@ -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 = - Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti - in - let* auditors = - (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) - (* does not contains auditor_keys with empty denomination_keys *) - Pg.get_auditor_keys db_conn - in - let extensions = None in - let extensions_sig = None in - Ok - ExchangeKeysResponse. - { - version; - base_url; - currency; - shopping_url; - open_banking_gateway; - bank_compliance_language; - currency_specification; - tiny_amount; - stefan_abs; - stefan_log; - stefan_lin; - asset_type; - accounts; - wire_fees; - wads; - rewards_allowed; - kyc_enabled; - disable_direct_deposit; - master_public_key; - reserve_closing_delay; - wallet_balance_limit_without_kyc; - hard_limits; - zero_limits; - denominations; - exchange_sig; - exchange_pub; - recoup; - global_fees; - list_issue_date; - auditors; - signkeys; - extensions; - extensions_sig; - } - -let jsont = ExchangeKeysResponse.jsont - -(* 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 deleted file mode 100644 index 61cb5e5e..00000000 --- a/.jjconflict-side-1/src/http_management.ml +++ /dev/null @@ -1,749 +0,0 @@ -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; - 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 deleted file mode 100644 index f98ee88f..00000000 --- a/.jjconflict-side-1/src/mte.ml +++ /dev/null @@ -1,77 +0,0 @@ -(* MTE - the MirageOS Taler Exchange - Copyright (C) 2025 Olivier Pierre - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Affero General Public License as published by - the Free Software Foundation, version 3. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Affero General Public License for more details. - - You should have received a copy of the GNU Affero General Public License - along with this program. If not, see . *) - -let hello req _server _env = - let open Vif.Response in - let open Syntax in - let* () = with_string req "Hello~~\n" in - let* () = add ~field:"content-type" "text/plain" in - respond `OK - -let routes = - let open Vif.Uri in - let open Vif.Route in - let get_ path = get (path /?? any) in - let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in - let 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 deleted file mode 100644 index cd2c141a..00000000 --- a/.jjconflict-side-1/src/parse_config.ml +++ /dev/null @@ -1,262 +0,0 @@ -(* 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 deleted file mode 100644 index 32428045..00000000 --- a/.jjconflict-side-1/src/pg.ml +++ /dev/null @@ -1,374 +0,0 @@ -(* 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 deleted file mode 100644 index 0a2e8f15..00000000 --- a/.jjconflict-side-1/src/pg_type.ml +++ /dev/null @@ -1,377 +0,0 @@ -(* 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 deleted file mode 100644 index 3c4faf5d..00000000 --- a/.jjconflict-side-1/src/respond_util.ml +++ /dev/null @@ -1,22 +0,0 @@ -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 deleted file mode 100644 index ed74310f..00000000 --- a/.jjconflict-side-1/src/secmod.ml +++ /dev/null @@ -1,407 +0,0 @@ -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 deleted file mode 100644 index 0205b866..00000000 --- a/.jjconflict-side-1/src/secmod.mli +++ /dev/null @@ -1,46 +0,0 @@ -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 deleted file mode 100644 index 6a6b67ce..00000000 --- a/.jjconflict-side-1/src/signatures.ml +++ /dev/null @@ -1,1308 +0,0 @@ -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; - 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 - denom_hash - -> - { - master; - start; - expire_withdraw; - expire_spend; - expire_legal; - value; - fee_withdraw; - fee_deposit; - fee_refresh; - 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 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 deleted file mode 100644 index 22a7a0cd..00000000 --- a/.jjconflict-side-1/src/signkey_data.ml +++ /dev/null @@ -1,10 +0,0 @@ -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 deleted file mode 100644 index 57b24dcd..00000000 --- a/.jjconflict-side-1/src/static.ml +++ /dev/null @@ -1,84 +0,0 @@ -(* 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 - s - end - - let bad_request ?hint req = - let body = error_detail ?hint `Bad_request 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* () = with_string ?compression:None req body in - let* () = add ~field:"accept" Headers.accept_header_value 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 -> Respond_with.bad_request ~hint:e req - | Ok true -> Respond_with.not_modified () - | Ok false -> ( - match Headers.select_mimetype headers with - | None -> 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) - -let terms req _server _env = aux Assets.Terms req _server _env -let privacy req _server _env = aux Assets.Privacy req _server _env diff --git a/.jjconflict-side-1/src/syntax.ml b/.jjconflict-side-1/src/syntax.ml deleted file mode 100644 index c61aba15..00000000 --- a/.jjconflict-side-1/src/syntax.ml +++ /dev/null @@ -1,51 +0,0 @@ -let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e -let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e - -(* TODO use polymorphic variant for errors *) -let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v - -let unwrap_err_caqti o = - match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v - -let list_iter f l = - let err = ref None in - try - List.iter - (fun v -> - match f v with - | Error _e as e -> - err := Some e; - raise Exit - | Ok () -> ()) - l; - Ok () - with Exit -> ( match !err with None -> assert false | Some v -> v) - -let list_map f l = - let err = ref None in - try - Ok - (List.map - (fun v -> - match f v with - | Error _e as e -> - err := Some e; - raise Exit - | Ok v -> v) - l) - with Exit -> ( match !err with None -> assert false | Some v -> v) - -let list_fold_left f acc l = - List.fold_left - (fun acc v -> - let* acc = acc in - f acc v) - (Ok acc) l - -let opt_list l = - match (List.for_all Option.is_none l, List.for_all Option.is_some l) with - | _, true -> - let l = List.map Option.get l in - Ok (Some l) - | true, _ -> Ok None - | _, _ -> Error () diff --git a/.jjconflict-side-1/src/time.ml b/.jjconflict-side-1/src/time.ml deleted file mode 100644 index 3c5af371..00000000 --- a/.jjconflict-side-1/src/time.ml +++ /dev/null @@ -1,151 +0,0 @@ -let uint64_max = Int64.minus_one - -module Relative = struct - type t = Int64.t - - let forever = uint64_max - let zero = 0L - let compare = Int64.unsigned_compare - let min a b = if compare a b < 0 then a else b - let max a b = if compare a b > 0 then a else b - - (* forever if either argument is forever or on overflow; otherwise a + b *) - let add a b = - if a = forever || b = forever then forever - else - let v = Int64.add a b in - if compare v a < 0 then forever else v - - (* zero if a <= b, or forever if a is forever; otherwise a - b *) - let sub a b = - if compare a b <= 0 then zero - else if a = forever then forever - else Int64.sub a b - - let of_s s = - let v = Int64.mul s 1_000_000L in - if Int64.unsigned_div v 1_000_000L <> s then forever else v - - let bin = Bin.neint64 - let bin_nbo = Bin.beint64 - - (* TODO should be in NBO here? *) - let caqti = - let encode v = Ok v in - let decode v = Ok v in - Caqti_type.custom ~encode ~decode Caqti_type.int64 - - (* TODO - reject negative / non-integer values - cap value at 2^53 - 1 inclusive *) - let jsont = - let jsont = - let forever_jsont = - let dec s = - match s with - | "forever" -> forever - | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" - in - let enc _t = "forever" in - Jsont.map ~dec ~enc Jsont.string - in - let num_jsont = Jsont.int64 in - let enc t = if t = forever then forever_jsont else num_jsont in - Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc () - in - Jsont.Object.map ~kind:"RelativeTime" Fun.id - |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id - |> Jsont.Object.finish -end - -module Absolute = struct - type t = Int64.t - - let never = uint64_max - let zero = 0L - let compare = Int64.unsigned_compare - let min a b = if compare a b < 0 then a else b - let max a b = if compare a b > 0 then a else b - - (* zero if a >= b; never if b=never; otherwise b - a *) - let diff a b = - if compare a b >= 0 then zero - else if b = never then never - else Int64.sub b a - - (* never if either argument is never/forever or on overflow; otherwise t + d *) - let add t d = - if t = never || d = never then never - else - let v = Int64.add t d in - if compare v t < 0 then never else v - - (* zero if t <= d, or never if t is never; otherwise t - d *) - let sub t d = - if compare t d <= 0 then zero - else if t = never then never - else Int64.sub t d - - let of_s s = - let v = Int64.mul s 1_000_000L in - if Int64.unsigned_div v 1_000_000L <> s then never else v - - let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s -end - -module Timestamp = struct - type t = Int64.t - - let never = uint64_max - let zero = 0L - let compare = Int64.unsigned_compare - - (* zero if a >= b; never if b=never; otherwise b - a *) - let diff a b = - if compare a b >= 0 then zero - else if b = never then never - else Int64.sub b a - - let of_s s = - let v = Int64.mul s 1_000_000L in - if Int64.unsigned_div v 1_000_000L <> s then never else v - - let to_s t = - if t = never then None else Some (Int64.unsigned_div t 1_000_000L) - - let of_absolute a = - if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L) - - let of_ptime v = v |> Absolute.of_ptime |> of_absolute - let bin = Bin.neint64 - let bin_nbo = Bin.beint64 - - let caqti = - let encode v = Ok v in - let decode v = Ok v in - Caqti_type.custom ~encode ~decode Caqti_type.int64 - - let jsont = - let jsont = - let never_jsont = - let dec s = - match s with - | "never" -> never - | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" - in - let enc _t = "never" in - Jsont.map ~dec ~enc Jsont.string - in - let num_jsont = - Jsont.map - ~dec:(fun n -> of_s n) - ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s) - Jsont.int64 - in - let enc t = if t = never then never_jsont else num_jsont in - Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc () - in - Jsont.Object.map ~kind:"Timestamp" Fun.id - |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id - |> Jsont.Object.finish -end diff --git a/.jjconflict-side-1/src/time.mli b/.jjconflict-side-1/src/time.mli deleted file mode 100644 index 180df904..00000000 --- a/.jjconflict-side-1/src/time.mli +++ /dev/null @@ -1,54 +0,0 @@ -module Relative : sig - type t - - val forever : t - val zero : t - val compare : t -> t -> int - val min : t -> t -> t - val max : t -> t -> t - val add : t -> t -> t - val sub : t -> t -> t - val of_s : int64 -> t - - (* - *) - val bin : t Bin.t - val bin_nbo : t Bin.t - val caqti : t Caqti_type.t - val jsont : t Jsont.t -end - -module Absolute : sig - type t - - val never : t - val zero : t - val compare : t -> t -> int - val min : t -> t -> t - val max : t -> t -> t - val diff : t -> t -> Relative.t - val add : t -> Relative.t -> t - val sub : t -> Relative.t -> t - val of_s : int64 -> t - val of_ptime : Ptime.t -> t -end - -module Timestamp : sig - type t - - val never : t - val zero : t - val compare : t -> t -> int - val diff : t -> t -> Relative.t - val of_s : int64 -> t - - (* none if t = never *) - val to_s : t -> int64 option - val of_absolute : Absolute.t -> t - val of_ptime : Ptime.t -> t - - (* - *) - val bin : t Bin.t - val bin_nbo : t Bin.t - val caqti : t Caqti_type.t - val jsont : t Jsont.t -end diff --git a/.jjconflict-side-1/src/timestamp.ml b/.jjconflict-side-1/src/timestamp.ml deleted file mode 100644 index 1a942758..00000000 --- a/.jjconflict-side-1/src/timestamp.ml +++ /dev/null @@ -1 +0,0 @@ -include Time.Timestamp diff --git a/.jjconflict-side-1/src/util.ml b/.jjconflict-side-1/src/util.ml deleted file mode 100644 index c690a009..00000000 --- a/.jjconflict-side-1/src/util.ml +++ /dev/null @@ -1,62 +0,0 @@ -module Log_reporter = struct - let detail_tag : string Logs.Tag.def = - Logs.Tag.def "Detail tag" ~doc:"" Fmt.string - - let detail s = Logs.Tag.(empty |> add detail_tag s) - let time_anchor = Ptime_clock.now () |> Ptime.to_span - - let color_of_log_level = function - | Logs.App -> `White - | Error -> `Red - | Warning -> `Yellow - | Info -> `Blue - | Debug -> `Magenta - - let reporter : Logs.reporter = - let open Fmt in - let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%04.02f")) in - let pp_header ppf v = - let color = color_of_log_level (fst v) in - let pp = styled (`Fg color) Logs.pp_header in - pf ppf "%a" pp v - in - let pp_src_name = - let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in - fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v - in - let pp_detail = option (styled `Green (fmt " (%s)")) in - let report src lvl ~over k msgf = - let ppf = - match lvl with - | Logs.App -> stdout - | Error | Warning | Info | Debug -> stderr - in - let k _ppf = over (); k () in - let with_detail h tags k user_fmt = - let detail = Option.bind tags (Logs.Tag.find detail_tag) in - let timestamp = - Ptime.sub_span (Ptime_clock.now ()) time_anchor - |> Option.map Ptime.to_float_s - |> Option.value ~default:0. - in - let k ppf = kpf k ppf "%a@." pp_detail detail in - let k ppf = kpf k ppf user_fmt in - kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h) - pp_src_name src - in - msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt - in - { report } - - (* TODO logs - - vif shouldn't use/set the default reporter - - Log.err all `Internal_server_error response *) - let setup () = - let level = Some Logs.Info in - Logs.set_level ~all:false level; - Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true (); - Logs.Src.set_level Logs.default level; - Logs_threaded.enable (); - Logs.set_reporter reporter; - () -end diff --git a/.jjconflict-side-1/test/dune b/.jjconflict-side-1/test/dune deleted file mode 100644 index 1eefa8ef..00000000 --- a/.jjconflict-side-1/test/dune +++ /dev/null @@ -1,11 +0,0 @@ -(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 deleted file mode 100755 index a4999491..00000000 --- a/.jjconflict-side-1/test/offline_management.sh +++ /dev/null @@ -1,45 +0,0 @@ -#!/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 deleted file mode 100644 index bcebe993..00000000 --- a/.jjconflict-side-1/test/signatures.c +++ /dev/null @@ -1,55 +0,0 @@ -#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-1/tools/dune b/.jjconflict-side-1/tools/dune deleted file mode 100644 index f500902e..00000000 --- a/.jjconflict-side-1/tools/dune +++ /dev/null @@ -1,7 +0,0 @@ -(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 deleted file mode 100644 index f40664fd..00000000 --- a/.jjconflict-side-1/tools/offline.ml +++ /dev/null @@ -1,313 +0,0 @@ -(* 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 deleted file mode 100644 index 3438ec66..00000000 --- a/.jjconflict-side-1/tools/offline_impl.ml +++ /dev/null @@ -1,230 +0,0 @@ -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 deleted file mode 100644 index 94675300..00000000 --- a/.jjconflict-side-1/tools/offline_sig.ml +++ /dev/null @@ -1,146 +0,0 @@ -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; - 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-base-0/.ocamlformat b/.ocamlformat similarity index 100% rename from .jjconflict-base-0/.ocamlformat rename to .ocamlformat diff --git a/.jjconflict-base-0/LICENSE b/LICENSE similarity index 100% rename from .jjconflict-base-0/LICENSE rename to LICENSE diff --git a/README b/README deleted file mode 100644 index 5be01972..00000000 --- a/README +++ /dev/null @@ -1,11 +0,0 @@ -This commit was made by jj, https://jj-vcs.dev/. -The commit contains file conflicts, and therefore looks wrong when used with plain -Git or other tools that are unfamiliar with jj. - -The .jjconflict-* directories represent the different inputs to the conflict. -For details, see -https://docs.jj-vcs.dev/prerelease/git-compatibility/#format-mapping-details - -If you see this file in your working copy, it probably means that you used a -regular `git` command to check out a conflicted commit. Use `jj abandon` to -recover. diff --git a/.jjconflict-base-0/data/assets/default.config b/data/assets/default.config similarity index 100% rename from .jjconflict-base-0/data/assets/default.config rename to data/assets/default.config diff --git a/.jjconflict-base-0/data/assets/privacy/en/0.md b/data/assets/privacy/en/0.md similarity index 100% rename from .jjconflict-base-0/data/assets/privacy/en/0.md rename to data/assets/privacy/en/0.md diff --git a/.jjconflict-base-0/data/assets/privacy/en/0.txt b/data/assets/privacy/en/0.txt similarity index 100% rename from .jjconflict-base-0/data/assets/privacy/en/0.txt rename to data/assets/privacy/en/0.txt diff --git a/.jjconflict-base-0/data/assets/terms/en/0.md b/data/assets/terms/en/0.md similarity index 100% rename from .jjconflict-base-0/data/assets/terms/en/0.md rename to data/assets/terms/en/0.md diff --git a/.jjconflict-base-0/data/assets/terms/en/0.txt b/data/assets/terms/en/0.txt similarity index 100% rename from .jjconflict-base-0/data/assets/terms/en/0.txt rename to data/assets/terms/en/0.txt diff --git a/.jjconflict-base-0/data/auditor_private_key b/data/auditor_private_key similarity index 100% rename from .jjconflict-base-0/data/auditor_private_key rename to data/auditor_private_key diff --git a/.jjconflict-base-0/data/auditor_public_key b/data/auditor_public_key similarity index 100% rename from .jjconflict-base-0/data/auditor_public_key rename to data/auditor_public_key diff --git a/.jjconflict-base-0/data/master_offline_private_key b/data/master_offline_private_key similarity index 100% rename from .jjconflict-base-0/data/master_offline_private_key rename to data/master_offline_private_key diff --git a/.jjconflict-base-0/data/secmod/.gitkeep b/data/secmod/.gitkeep similarity index 100% rename from .jjconflict-base-0/data/secmod/.gitkeep rename to data/secmod/.gitkeep diff --git a/.jjconflict-base-0/dune-project b/dune-project similarity index 100% rename from .jjconflict-base-0/dune-project rename to dune-project diff --git a/.jjconflict-base-0/include/dune b/include/dune similarity index 100% rename from .jjconflict-base-0/include/dune rename to include/dune diff --git a/.jjconflict-base-0/include/taler_signatures.ml b/include/taler_signatures.ml similarity index 100% rename from .jjconflict-base-0/include/taler_signatures.ml rename to include/taler_signatures.ml diff --git a/.jjconflict-base-0/mte.opam b/mte.opam similarity index 100% rename from .jjconflict-base-0/mte.opam rename to mte.opam diff --git a/.jjconflict-base-0/src/amount.ml b/src/amount.ml similarity index 100% rename from .jjconflict-base-0/src/amount.ml rename to src/amount.ml diff --git a/.jjconflict-base-0/src/amount.mli b/src/amount.mli similarity index 100% rename from .jjconflict-base-0/src/amount.mli rename to src/amount.mli diff --git a/.jjconflict-base-0/src/api.ml b/src/api.ml similarity index 100% rename from .jjconflict-base-0/src/api.ml rename to src/api.ml diff --git a/.jjconflict-base-0/src/assets.ml b/src/assets.ml similarity index 100% rename from .jjconflict-base-0/src/assets.ml rename to src/assets.ml diff --git a/.jjconflict-base-0/src/b32.ml b/src/b32.ml similarity index 100% rename from .jjconflict-base-0/src/b32.ml rename to src/b32.ml diff --git a/.jjconflict-base-0/src/config.ml b/src/config.ml similarity index 100% rename from .jjconflict-base-0/src/config.ml rename to src/config.ml diff --git a/.jjconflict-base-0/src/crypto.ml b/src/crypto.ml similarity index 100% rename from .jjconflict-base-0/src/crypto.ml rename to src/crypto.ml diff --git a/.jjconflict-base-0/src/data_file.ml b/src/data_file.ml similarity index 100% rename from .jjconflict-base-0/src/data_file.ml rename to src/data_file.ml diff --git a/.jjconflict-base-0/src/denom_data.ml b/src/denom_data.ml similarity index 100% rename from .jjconflict-base-0/src/denom_data.ml rename to src/denom_data.ml diff --git a/.jjconflict-base-0/src/devices.ml b/src/devices.ml similarity index 100% rename from .jjconflict-base-0/src/devices.ml rename to src/devices.ml diff --git a/.jjconflict-base-0/src/dune b/src/dune similarity index 100% rename from .jjconflict-base-0/src/dune rename to src/dune diff --git a/.jjconflict-base-0/src/hash.ml b/src/hash.ml similarity index 100% rename from .jjconflict-base-0/src/hash.ml rename to src/hash.ml diff --git a/.jjconflict-base-0/src/headers.ml b/src/headers.ml similarity index 100% rename from .jjconflict-base-0/src/headers.ml rename to src/headers.ml diff --git a/.jjconflict-base-0/src/headers_lib.ml b/src/headers_lib.ml similarity index 100% rename from .jjconflict-base-0/src/headers_lib.ml rename to src/headers_lib.ml diff --git a/.jjconflict-base-0/src/http_keys.ml b/src/http_keys.ml similarity index 100% rename from .jjconflict-base-0/src/http_keys.ml rename to src/http_keys.ml diff --git a/.jjconflict-base-0/src/http_management.ml b/src/http_management.ml similarity index 100% rename from .jjconflict-base-0/src/http_management.ml rename to src/http_management.ml diff --git a/.jjconflict-base-0/src/mte.ml b/src/mte.ml similarity index 100% rename from .jjconflict-base-0/src/mte.ml rename to src/mte.ml diff --git a/.jjconflict-base-0/src/parse_config.ml b/src/parse_config.ml similarity index 100% rename from .jjconflict-base-0/src/parse_config.ml rename to src/parse_config.ml diff --git a/.jjconflict-base-0/src/pg.ml b/src/pg.ml similarity index 100% rename from .jjconflict-base-0/src/pg.ml rename to src/pg.ml diff --git a/.jjconflict-base-0/src/pg_type.ml b/src/pg_type.ml similarity index 100% rename from .jjconflict-base-0/src/pg_type.ml rename to src/pg_type.ml diff --git a/.jjconflict-base-0/src/respond_util.ml b/src/respond_util.ml similarity index 100% rename from .jjconflict-base-0/src/respond_util.ml rename to src/respond_util.ml diff --git a/.jjconflict-base-0/src/secmod.ml b/src/secmod.ml similarity index 100% rename from .jjconflict-base-0/src/secmod.ml rename to src/secmod.ml diff --git a/.jjconflict-base-0/src/secmod.mli b/src/secmod.mli similarity index 100% rename from .jjconflict-base-0/src/secmod.mli rename to src/secmod.mli diff --git a/.jjconflict-base-0/src/signatures.ml b/src/signatures.ml similarity index 100% rename from .jjconflict-base-0/src/signatures.ml rename to src/signatures.ml diff --git a/.jjconflict-base-0/src/signkey_data.ml b/src/signkey_data.ml similarity index 100% rename from .jjconflict-base-0/src/signkey_data.ml rename to src/signkey_data.ml diff --git a/.jjconflict-base-0/src/static.ml b/src/static.ml similarity index 100% rename from .jjconflict-base-0/src/static.ml rename to src/static.ml diff --git a/.jjconflict-base-0/src/syntax.ml b/src/syntax.ml similarity index 100% rename from .jjconflict-base-0/src/syntax.ml rename to src/syntax.ml diff --git a/.jjconflict-base-0/src/time.ml b/src/time.ml similarity index 100% rename from .jjconflict-base-0/src/time.ml rename to src/time.ml diff --git a/.jjconflict-base-0/src/time.mli b/src/time.mli similarity index 100% rename from .jjconflict-base-0/src/time.mli rename to src/time.mli diff --git a/.jjconflict-base-0/src/timestamp.ml b/src/timestamp.ml similarity index 100% rename from .jjconflict-base-0/src/timestamp.ml rename to src/timestamp.ml diff --git a/.jjconflict-base-0/src/util.ml b/src/util.ml similarity index 100% rename from .jjconflict-base-0/src/util.ml rename to src/util.ml diff --git a/.jjconflict-base-0/test/dune b/test/dune similarity index 100% rename from .jjconflict-base-0/test/dune rename to test/dune diff --git a/.jjconflict-base-0/test/offline_management.sh b/test/offline_management.sh similarity index 100% rename from .jjconflict-base-0/test/offline_management.sh rename to test/offline_management.sh diff --git a/.jjconflict-base-0/test/signatures.c b/test/signatures.c similarity index 100% rename from .jjconflict-base-0/test/signatures.c rename to test/signatures.c diff --git a/.jjconflict-side-1/test/test.ml b/test/test.ml similarity index 100% rename from .jjconflict-side-1/test/test.ml rename to test/test.ml diff --git a/.jjconflict-base-0/tools/dune b/tools/dune similarity index 100% rename from .jjconflict-base-0/tools/dune rename to tools/dune diff --git a/.jjconflict-base-0/tools/offline.ml b/tools/offline.ml similarity index 100% rename from .jjconflict-base-0/tools/offline.ml rename to tools/offline.ml diff --git a/.jjconflict-base-0/tools/offline_impl.ml b/tools/offline_impl.ml similarity index 100% rename from .jjconflict-base-0/tools/offline_impl.ml rename to tools/offline_impl.ml diff --git a/.jjconflict-base-0/tools/offline_sig.ml b/tools/offline_sig.ml similarity index 100% rename from .jjconflict-base-0/tools/offline_sig.ml rename to tools/offline_sig.ml