diff --git a/.gitignore b/.jjconflict-base-0/.gitignore
similarity index 100%
rename from .gitignore
rename to .jjconflict-base-0/.gitignore
diff --git a/.ocamlformat b/.jjconflict-base-0/.ocamlformat
similarity index 100%
rename from .ocamlformat
rename to .jjconflict-base-0/.ocamlformat
diff --git a/LICENSE b/.jjconflict-base-0/LICENSE
similarity index 100%
rename from LICENSE
rename to .jjconflict-base-0/LICENSE
diff --git a/default/assets/mte.conf b/.jjconflict-base-0/default/assets/mte.conf
similarity index 100%
rename from default/assets/mte.conf
rename to .jjconflict-base-0/default/assets/mte.conf
diff --git a/default/assets/privacy/en/0.md b/.jjconflict-base-0/default/assets/privacy/en/0.md
similarity index 100%
rename from default/assets/privacy/en/0.md
rename to .jjconflict-base-0/default/assets/privacy/en/0.md
diff --git a/default/assets/privacy/en/0.txt b/.jjconflict-base-0/default/assets/privacy/en/0.txt
similarity index 100%
rename from default/assets/privacy/en/0.txt
rename to .jjconflict-base-0/default/assets/privacy/en/0.txt
diff --git a/default/assets/terms/en/0.md b/.jjconflict-base-0/default/assets/terms/en/0.md
similarity index 100%
rename from default/assets/terms/en/0.md
rename to .jjconflict-base-0/default/assets/terms/en/0.md
diff --git a/default/assets/terms/en/0.txt b/.jjconflict-base-0/default/assets/terms/en/0.txt
similarity index 100%
rename from default/assets/terms/en/0.txt
rename to .jjconflict-base-0/default/assets/terms/en/0.txt
diff --git a/default/master_offline_private_key b/.jjconflict-base-0/default/master_offline_private_key
similarity index 100%
rename from default/master_offline_private_key
rename to .jjconflict-base-0/default/master_offline_private_key
diff --git a/dune-project b/.jjconflict-base-0/dune-project
similarity index 100%
rename from dune-project
rename to .jjconflict-base-0/dune-project
diff --git a/mte.opam b/.jjconflict-base-0/mte.opam
similarity index 100%
rename from mte.opam
rename to .jjconflict-base-0/mte.opam
diff --git a/secrets/.keep b/.jjconflict-base-0/secrets/.keep
similarity index 100%
rename from secrets/.keep
rename to .jjconflict-base-0/secrets/.keep
diff --git a/src/amount.ml b/.jjconflict-base-0/src/amount.ml
similarity index 100%
rename from src/amount.ml
rename to .jjconflict-base-0/src/amount.ml
diff --git a/src/amount.mli b/.jjconflict-base-0/src/amount.mli
similarity index 100%
rename from src/amount.mli
rename to .jjconflict-base-0/src/amount.mli
diff --git a/src/api.ml b/.jjconflict-base-0/src/api.ml
similarity index 100%
rename from src/api.ml
rename to .jjconflict-base-0/src/api.ml
diff --git a/.jjconflict-base-0/src/assets.ml b/.jjconflict-base-0/src/assets.ml
new file mode 100644
index 00000000..4e1b5e1e
--- /dev/null
+++ b/.jjconflict-base-0/src/assets.ml
@@ -0,0 +1,167 @@
+(* https://docs.taler.net/design-documents/003-tos-rendering.html
+ https://docs.taler.net/design-documents/003-tos-rendering.html
+
+ must support `text/plain` and `text/markdown` *)
+
+type t =
+ | Terms
+ | Privacy
+
+module Assets_config = struct
+ (* hardcoded config just for static assets *)
+ let default_lang = "en"
+ let default_mimetype = ("text", "plain")
+ let default_extension = ".txt"
+ let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
+ let base_dir = function Terms -> "terms" | Privacy -> "privacy"
+
+ (* TODO this should be in the config like terms_etag *)
+ let terms_legal_version = "0"
+end
+
+let etag k =
+ let etag =
+ match k with Terms -> Config.terms_etag | Privacy -> Config.privacy_etag
+ in
+ etag |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
+
+let supported_lang_arr, supported_ext_arr =
+ let aux t =
+ let prefix = Fpath.v (Assets_config.base_dir t) in
+ let path_l = List.map Fpath.v Assets_crunch.file_list in
+ let path_l = List.filter_map (Fpath.rem_prefix prefix) path_l in
+ let ext_l =
+ path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
+ in
+ let lang_l =
+ List.map
+ (fun path ->
+ match Fpath.segs path with
+ | [] -> assert false
+ | [ dir; _file ] -> dir
+ | _l ->
+ Fmt.failwith "invalid folder structure, file `%s` is misplaced"
+ (Fpath.to_string Fpath.(prefix // path)))
+ path_l
+ in
+ let lang_l = List.sort_uniq String.compare lang_l in
+ let etag = Headers_lib.Etag.to_raw_string (etag t) in
+ List.iter
+ (fun path ->
+ let etag' = Fpath.to_string (Fpath.rem_ext (Fpath.base path)) in
+ if not @@ String.equal etag etag' then
+ Fmt.failwith
+ "filename of file `%s` does not match configuration ETAG value `%s`"
+ (Fpath.to_string Fpath.(prefix // path))
+ etag)
+ path_l;
+ if List.is_empty lang_l then Fmt.failwith "no language supported";
+ if List.is_empty ext_l then Fmt.failwith "no mimetype supported";
+ if not @@ List.mem Assets_config.default_lang lang_l then
+ Fmt.failwith "default language `%s` files not found"
+ Assets_config.default_lang;
+ if not @@ List.mem ".txt" ext_l then
+ Fmt.failwith "plain text file not found";
+ if not @@ List.mem ".md" ext_l then Fmt.failwith "markdown file not found";
+ List.iter
+ (fun dir ->
+ if String.length dir <> 2 then
+ Fmt.failwith "language directory with invalid name: `%s`" dir)
+ lang_l;
+ if List.length path_l <> List.length ext_l * List.length lang_l then
+ Fmt.failwith
+ "invalid folder structure, all supported language must provide the \
+ same set of file mimetype"
+ else (lang_l, ext_l)
+ in
+ let lang_l, ext_l = aux Terms in
+ let lang_l', ext_l' = aux Privacy in
+ match
+ List.equal String.equal lang_l lang_l'
+ && List.equal String.equal ext_l ext_l'
+ with
+ | false ->
+ Fmt.failwith
+ "invalid folder structure, /terms and /privacy must support the same \
+ set of languages and mimetypes"
+ | true -> (Array.of_list lang_l, Array.of_list ext_l)
+
+module Mimetype = struct
+ type t = string * string
+
+ let pp fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
+
+ let assoc =
+ List.filter
+ (fun (_mime, ext) -> Array.mem ext supported_ext_arr)
+ [
+ (("text", "plain"), ".txt");
+ (("text", "markdown"), ".md");
+ (("text", "html"), ".html");
+ (("text", "html"), ".htm");
+ (("application", "pdf"), ".pdf");
+ (("image", "jpeg"), ".jpg");
+ (("image", "jpeg"), ".jpeg");
+ (("image", "png"), ".png");
+ (("image", "gif"), ".gif");
+ ]
+
+ let arr =
+ let all_supported, all_supported_ext = List.split assoc in
+ match
+ Array.find_opt
+ (fun ext -> not @@ List.exists (( = ) ext) all_supported_ext)
+ supported_ext_arr
+ with
+ | Some ext -> Fmt.failwith "extension `%s` unsupported" ext
+ | None -> Array.of_list all_supported
+
+ let default =
+ match
+ List.mem
+ (Assets_config.default_mimetype, Assets_config.default_extension)
+ assoc
+ with
+ | false ->
+ Fmt.failwith "default content type `%a` not supported" pp
+ Assets_config.default_mimetype
+ | true -> Assets_config.default_mimetype
+
+ let of_cohttp = function
+ | Cohttp.Accept.MediaType (m, m_sub) ->
+ Array.find_opt (( = ) (m, m_sub)) arr
+ | AnyMediaSubtype m -> Array.find_opt (fun (m', _) -> String.equal m m') arr
+ | AnyMedia -> Some default
+
+ let to_extension_exn t =
+ match List.assoc_opt t assoc with
+ | None -> Fmt.failwith "Mimetype.to_extension failure: `%a` unknown" pp t
+ | Some ext -> ext
+end
+
+module Language = struct
+ type t = string
+
+ let arr = supported_lang_arr
+ let default = Assets_config.default_lang
+
+ let of_cohttp = function
+ | Cohttp.Accept.AnyLanguage -> Some default
+ | Language language_range -> (
+ (* ignore language subtags (e.g. "en-US" -> "en") *)
+ match language_range with
+ | [] -> assert false
+ | lang :: _ when Array.mem lang supported_lang_arr -> Some lang
+ | _ -> None)
+end
+
+(* ! lang and mime must be supported *)
+let get_content ~lang ~mime t =
+ let etag = Headers_lib.Etag.to_raw_string (etag t) in
+ let ext = Mimetype.to_extension_exn mime in
+ let path =
+ Fpath.to_string Fpath.((v (Assets_config.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/src/b32.ml b/.jjconflict-base-0/src/b32.ml
similarity index 100%
rename from src/b32.ml
rename to .jjconflict-base-0/src/b32.ml
diff --git a/src/config.ml b/.jjconflict-base-0/src/config.ml
similarity index 98%
rename from src/config.ml
rename to .jjconflict-base-0/src/config.ml
index d6222c6b..3ccc104b 100644
--- a/src/config.ml
+++ b/.jjconflict-base-0/src/config.ml
@@ -44,8 +44,8 @@ module Exchange = struct
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 terms_etag = get "terms_etag" |> etag
+ let privacy_etag = get "privacy_etag" |> etag
let base_url = get "base_url"
let shopping_url = get_opt "shopping_url"
let open_banking_gateway_url = get_opt "open_banking_gateway_url"
diff --git a/src/crypto.ml b/.jjconflict-base-0/src/crypto.ml
similarity index 100%
rename from src/crypto.ml
rename to .jjconflict-base-0/src/crypto.ml
diff --git a/src/data_file.ml b/.jjconflict-base-0/src/data_file.ml
similarity index 100%
rename from src/data_file.ml
rename to .jjconflict-base-0/src/data_file.ml
diff --git a/src/denom_data.ml b/.jjconflict-base-0/src/denom_data.ml
similarity index 100%
rename from src/denom_data.ml
rename to .jjconflict-base-0/src/denom_data.ml
diff --git a/src/devices.ml b/.jjconflict-base-0/src/devices.ml
similarity index 100%
rename from src/devices.ml
rename to .jjconflict-base-0/src/devices.ml
diff --git a/src/dune b/.jjconflict-base-0/src/dune
similarity index 100%
rename from src/dune
rename to .jjconflict-base-0/src/dune
diff --git a/src/hash.ml b/.jjconflict-base-0/src/hash.ml
similarity index 100%
rename from src/hash.ml
rename to .jjconflict-base-0/src/hash.ml
diff --git a/src/headers.ml b/.jjconflict-base-0/src/headers.ml
similarity index 97%
rename from src/headers.ml
rename to .jjconflict-base-0/src/headers.ml
index b91e2f7b..fb2070bc 100644
--- a/src/headers.ml
+++ b/.jjconflict-base-0/src/headers.ml
@@ -10,6 +10,7 @@ let avail_languages_header_value =
let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
s
+(* TODO Cohttp raises on invalid *)
let select_mimetype headers =
let opt = Vif.Headers.get headers "accept" in
Cohttp.Accept.media_ranges opt
diff --git a/.jjconflict-base-0/src/headers_lib.ml b/.jjconflict-base-0/src/headers_lib.ml
new file mode 100644
index 00000000..e76a589a
--- /dev/null
+++ b/.jjconflict-base-0/src/headers_lib.ml
@@ -0,0 +1,69 @@
+module Etag = struct
+ (* https://httpwg.org/specs/rfc9110.html#field.etag *)
+
+ type t = {
+ weak: bool;
+ value: string;
+ }
+
+ let pp ppf { weak; value } =
+ match weak with
+ | false -> Fmt.pf ppf {|"%s"|} value
+ | true -> Fmt.pf ppf {|W/"%s"|} value
+
+ let to_field_string t = Fmt.str "%a" pp t
+
+ let angstrom =
+ let open Angstrom in
+ let is_valid_char c =
+ let n = Char.code c in
+ (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+ in
+ let quoted_string = char '"' *> take_while is_valid_char <* char '"' in
+ lift2
+ (fun weak value -> { weak; value })
+ (option false (string "W/" *> return true))
+ quoted_string
+
+ let parse s =
+ match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+ | Error _e -> Fmt.error "invalid etag: `%s`" s
+ | Ok v -> Ok v
+end
+
+module If_none_match = struct
+ type t =
+ | Any
+ | List of Etag.t list
+
+ let pp ppf = function
+ | Any -> Fmt.pf ppf {|*|}
+ | List l -> Fmt.pf ppf {|%a|} (Fmt.list ~sep:(Fmt.any ", ") Etag.pp) l
+
+ let angstrom =
+ let open Angstrom in
+ let ows = skip_while (function ' ' | '\t' -> true | _ -> false) in
+ let comma = ows *> char ',' *> ows in
+ (* A recipient MUST parse and ignore a reasonable number of empty list elements *)
+ let etag_opt = Etag.angstrom >>| Option.some <|> return None in
+ let etags =
+ etag_opt >>= fun hd ->
+ many (comma *> etag_opt) >>= fun tl ->
+ let l = List.filter_map Fun.id (hd :: tl) in
+ match l with [] -> fail "empty etag list" | l -> return (List l)
+ in
+ let any = char '*' *> return Any in
+ any <|> etags
+
+ let parse s =
+ match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+ | Error _e -> Fmt.error "invalid if-none-match field: `%s`" s
+ | Ok v -> Ok v
+
+ let evaluate etag t =
+ match t with
+ | Any -> false
+ | List l ->
+ not
+ @@ List.exists (fun e -> String.equal etag.Etag.value e.Etag.value) l
+end
diff --git a/src/http_information.ml b/.jjconflict-base-0/src/http_information.ml
similarity index 100%
rename from src/http_information.ml
rename to .jjconflict-base-0/src/http_information.ml
diff --git a/src/http_management.ml b/.jjconflict-base-0/src/http_management.ml
similarity index 100%
rename from src/http_management.ml
rename to .jjconflict-base-0/src/http_management.ml
diff --git a/src/mte.ml b/.jjconflict-base-0/src/mte.ml
similarity index 100%
rename from src/mte.ml
rename to .jjconflict-base-0/src/mte.ml
diff --git a/src/parse_config.ml b/.jjconflict-base-0/src/parse_config.ml
similarity index 95%
rename from src/parse_config.ml
rename to .jjconflict-base-0/src/parse_config.ml
index b93e0149..86254830 100644
--- a/src/parse_config.ml
+++ b/.jjconflict-base-0/src/parse_config.ml
@@ -189,6 +189,15 @@ let ed25519 s =
|> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
|> unwrap
+let etag s =
+ match Headers_lib.Etag.parse s with
+ | Ok etag -> etag
+ | Error e -> (
+ (* retry with quotes if needed *)
+ match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with
+ | Ok etag -> etag
+ | Error _ -> fail "could not parse etag `%s`: %s" s e)
+
(* TODO
move to another module
can we type the json as a Int_map directly? *)
diff --git a/src/pg.ml b/.jjconflict-base-0/src/pg.ml
similarity index 100%
rename from src/pg.ml
rename to .jjconflict-base-0/src/pg.ml
diff --git a/src/pg_type.ml b/.jjconflict-base-0/src/pg_type.ml
similarity index 100%
rename from src/pg_type.ml
rename to .jjconflict-base-0/src/pg_type.ml
diff --git a/src/respond_util.ml b/.jjconflict-base-0/src/respond_util.ml
similarity index 100%
rename from src/respond_util.ml
rename to .jjconflict-base-0/src/respond_util.ml
diff --git a/src/secmod.ml b/.jjconflict-base-0/src/secmod.ml
similarity index 100%
rename from src/secmod.ml
rename to .jjconflict-base-0/src/secmod.ml
diff --git a/src/secmod.mli b/.jjconflict-base-0/src/secmod.mli
similarity index 100%
rename from src/secmod.mli
rename to .jjconflict-base-0/src/secmod.mli
diff --git a/src/signatures.ml b/.jjconflict-base-0/src/signatures.ml
similarity index 100%
rename from src/signatures.ml
rename to .jjconflict-base-0/src/signatures.ml
diff --git a/src/signkey_data.ml b/.jjconflict-base-0/src/signkey_data.ml
similarity index 100%
rename from src/signkey_data.ml
rename to .jjconflict-base-0/src/signkey_data.ml
diff --git a/.jjconflict-base-0/src/static.ml b/.jjconflict-base-0/src/static.ml
new file mode 100644
index 00000000..12f7f017
--- /dev/null
+++ b/.jjconflict-base-0/src/static.ml
@@ -0,0 +1,78 @@
+(* /terms + /privacy *)
+
+(* TODO response *)
+module Respond_with = struct
+ open Vif.Response
+ open Syntax
+
+ open struct
+ let error_detail ?hint _status =
+ let open Api in
+ let code = -1 in
+ let err = ErrorDetail.make ?hint code in
+ let s = encode_exn ErrorDetail.jsont err in
+ Logs.err (fun m -> m "ErrorDetail: `%s`" s);
+ s
+ end
+
+ let bad_request ?hint req =
+ let body = error_detail ?hint `Bad_request in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string ?compression:None req body in
+ respond `Bad_request
+
+ let not_modified () =
+ let* () = empty in
+ respond `Not_modified
+end
+
+let aux asset req _server _env =
+ let etag = Assets.etag asset in
+ let headers = Vif.Request.headers req in
+ let has_matching_etag =
+ match Vif.Headers.get headers "if-none-match" with
+ | None -> Ok false
+ | Some s ->
+ Result.map (Headers_lib.Etag.evaluate etag) (Headers_lib.Etag.parse s)
+ in
+ match has_matching_etag with
+ | Error e ->
+ Logs.err (fun m -> m "bad request");
+ Respond_with.bad_request ~hint:e req
+ | Ok true ->
+ Logs.err (fun m -> m "not modified");
+ Respond_with.not_modified ()
+ | Ok false ->
+ let mime = Headers.select_mimetype headers in
+ let lang = Headers.select_language headers in
+ let compression = Headers.select_encoding headers in
+ let data = Assets.get_content ~mime ~lang asset in
+ (* -- *)
+ let open Vif.Response in
+ let open Syntax in
+ let* () = with_string ?compression req data in
+ let* () =
+ let etag_field_value = Headers_lib.Etag.to_field_value etag in
+ add ~field:"etag" etag_field_value
+ in
+ let* () =
+ add ~field:"taler-terms-version"
+ Assets.Assets_config.terms_legal_version
+ in
+ let* () =
+ add ~field:"avail-languages" Headers.avail_languages_header_value
+ in
+ let* () =
+ let content_type = Fmt.str "%a" Assets.Mimetype.pp mime in
+ add ~field:"content-type" content_type
+ in
+ let* () = add ~field:"content-language" lang in
+ respond `OK
+
+let terms req _server _env =
+ Logs.info (fun m -> m "GET /terms");
+ aux Assets.Terms req _server _env
+
+let privacy req _server _env =
+ Logs.info (fun m -> m "GET /privacy");
+ aux Assets.Privacy req _server _env
diff --git a/src/syntax.ml b/.jjconflict-base-0/src/syntax.ml
similarity index 100%
rename from src/syntax.ml
rename to .jjconflict-base-0/src/syntax.ml
diff --git a/src/taler_signatures.ml b/.jjconflict-base-0/src/taler_signatures.ml
similarity index 100%
rename from src/taler_signatures.ml
rename to .jjconflict-base-0/src/taler_signatures.ml
diff --git a/src/time.ml b/.jjconflict-base-0/src/time.ml
similarity index 100%
rename from src/time.ml
rename to .jjconflict-base-0/src/time.ml
diff --git a/src/time.mli b/.jjconflict-base-0/src/time.mli
similarity index 100%
rename from src/time.mli
rename to .jjconflict-base-0/src/time.mli
diff --git a/src/timestamp.ml b/.jjconflict-base-0/src/timestamp.ml
similarity index 100%
rename from src/timestamp.ml
rename to .jjconflict-base-0/src/timestamp.ml
diff --git a/src/util.ml b/.jjconflict-base-0/src/util.ml
similarity index 100%
rename from src/util.ml
rename to .jjconflict-base-0/src/util.ml
diff --git a/test/auditor_public_key b/.jjconflict-base-0/test/auditor_public_key
similarity index 100%
rename from test/auditor_public_key
rename to .jjconflict-base-0/test/auditor_public_key
diff --git a/test/crypto.ml b/.jjconflict-base-0/test/crypto.ml
similarity index 100%
rename from test/crypto.ml
rename to .jjconflict-base-0/test/crypto.ml
diff --git a/test/dune b/.jjconflict-base-0/test/dune
similarity index 100%
rename from test/dune
rename to .jjconflict-base-0/test/dune
diff --git a/test/offline_management.sh b/.jjconflict-base-0/test/offline_management.sh
similarity index 100%
rename from test/offline_management.sh
rename to .jjconflict-base-0/test/offline_management.sh
diff --git a/test/signatures.c b/.jjconflict-base-0/test/signatures.c
similarity index 100%
rename from test/signatures.c
rename to .jjconflict-base-0/test/signatures.c
diff --git a/test/test.ml b/.jjconflict-base-0/test/test.ml
similarity index 78%
rename from test/test.ml
rename to .jjconflict-base-0/test/test.ml
index aa577b06..b1c2810b 100644
--- a/test/test.ml
+++ b/.jjconflict-base-0/test/test.ml
@@ -62,32 +62,39 @@ let () =
()
let () =
- let open Headers_lib.Etag in
- let check input = assert (Result.is_ok (parse input)) in
+ let open Headers_lib.If_none_match in
+ let ok_l =
+ [
+ "*";
+ "\"foo\"";
+ "W/\"foo\"";
+ "\"foo\", \"bar\"";
+ " , W/\"x\" , W/\"y\" , \"z\"";
+ ", \"one\" , \"two\" , \"three\"";
+ "W/\"a\" , ";
+ "W/\"a\" , \"b\"";
+ ]
+ in
+ let bad_l =
+ [
+ "";
+ "foo";
+ "W/foo";
+ "W/\"unterminated";
+ "\"foo\", W/";
+ "* , \"bar\"";
+ "\"a\" \"b\"";
+ "W/\"a\" W/\"b\"";
+ "\"fo\x7Fo\"";
+ " W/\"a\"";
+ "W/\"a\" ";
+ ]
+ in
+ let check_ok input = assert (Result.is_ok (parse input)) in
let check_bad input = assert (Result.is_error (parse input)) in
+ List.iter check_ok ok_l;
+ List.iter check_bad bad_l;
- 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\"";
()
(*
diff --git a/tools/dbinit.sh b/.jjconflict-base-0/tools/dbinit.sh
similarity index 100%
rename from tools/dbinit.sh
rename to .jjconflict-base-0/tools/dbinit.sh
diff --git a/tools/dune b/.jjconflict-base-0/tools/dune
similarity index 100%
rename from tools/dune
rename to .jjconflict-base-0/tools/dune
diff --git a/tools/gen_signatures_registry.ml b/.jjconflict-base-0/tools/gen_signatures_registry.ml
similarity index 100%
rename from tools/gen_signatures_registry.ml
rename to .jjconflict-base-0/tools/gen_signatures_registry.ml
diff --git a/tools/offline.ml b/.jjconflict-base-0/tools/offline.ml
similarity index 100%
rename from tools/offline.ml
rename to .jjconflict-base-0/tools/offline.ml
diff --git a/tools/offline_impl.ml b/.jjconflict-base-0/tools/offline_impl.ml
similarity index 100%
rename from tools/offline_impl.ml
rename to .jjconflict-base-0/tools/offline_impl.ml
diff --git a/.jjconflict-side-0/.gitignore b/.jjconflict-side-0/.gitignore
new file mode 100644
index 00000000..7aeab444
--- /dev/null
+++ b/.jjconflict-side-0/.gitignore
@@ -0,0 +1,5 @@
+_build
+_taler_exchange_sql
+assets
+secrets
+!secrets/.keep
diff --git a/.jjconflict-side-0/.ocamlformat b/.jjconflict-side-0/.ocamlformat
new file mode 100644
index 00000000..43b12fc0
--- /dev/null
+++ b/.jjconflict-side-0/.ocamlformat
@@ -0,0 +1,15 @@
+version=0.28.1
+exp-grouping=preserve
+type-decl=sparse
+break-infix=fit-or-vertical
+break-collection-expressions=fit-or-vertical
+break-sequences=false
+break-infix-before-func=false
+dock-collection-brackets=true
+break-separators=after
+field-space=tight
+if-then-else=compact
+break-sequences=false
+sequence-blank-line=compact
+exp-grouping=preserve
+sequence-blank-line=preserve-one
diff --git a/.jjconflict-side-0/LICENSE b/.jjconflict-side-0/LICENSE
new file mode 100644
index 00000000..be3f7b28
--- /dev/null
+++ b/.jjconflict-side-0/LICENSE
@@ -0,0 +1,661 @@
+ GNU AFFERO GENERAL PUBLIC LICENSE
+ Version 3, 19 November 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+ A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate. Many developers of free software are heartened and
+encouraged by the resulting cooperation. However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+ The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community. It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server. Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+ An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals. This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing under
+this license.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU Affero General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Remote Network Interaction; Use with the GNU General Public License.
+
+ Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your version
+supports such interaction) an opportunity to receive the Corresponding
+Source of your version by providing access to the Corresponding Source
+from a network server at no charge, through some standard or customary
+means of facilitating copying of software. This Corresponding Source
+shall include the Corresponding Source for any work covered by version 3
+of the GNU General Public License that is incorporated pursuant to the
+following paragraph.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU Affero General Public License from time to time. Such new versions
+will be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for the
+specific requirements.
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU AGPL, see
+.
diff --git a/.jjconflict-side-0/default/assets/mte.conf b/.jjconflict-side-0/default/assets/mte.conf
new file mode 100644
index 00000000..a6c89c52
--- /dev/null
+++ b/.jjconflict-side-0/default/assets/mte.conf
@@ -0,0 +1,74 @@
+[currency-EUR]
+enabled= YES
+code= EUR
+name= euro
+fractional_input_digits= 2
+fractional_normal_digits= 2
+fractional_trailing_zero_digits= 2
+alt_unit_names= "{"0":"€","3":"k€"}"
+
+[exchange]
+currency = EUR
+currency_round_unit = EUR:0.01
+db = postgres
+attribute_encryption_key = "deadbeef"
+port = 3434
+bind_to = localhost
+master_public_key = "SJ0NYND22VQP3MP7FM754RDX8HCKVWAXTHY9SQNBTPRJZ2SPM2S0"
+stefan_abs = EUR:0.00
+stefan_log = EUR:0.00
+stefan_lin = 0.00
+aggregator_idle_sleep_interval = "1 hour"
+closer_idle_sleep_interval = "1 hour"
+transfer_idle_sleep_interval = "1 hour"
+wirewatch_idle_sleep_interval = "1 hour"
+signkey_legal_duration = "1 year"
+max_keys_caching = "4 weeks"
+enable_kyc = NO
+terms_etag = "0"
+privacy_etag = "0"
+base_url = "http://localhost:3434/"
+
+[exchangedb]
+idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds"
+legal_reserve_expiration_time = "1 year"
+aggregator_shift = "1 year"
+max_aml_program_runtime = "1 year"
+default_purse_limit = 9999
+
+[exchangedb-postgres]
+config = "pgx://mte:hunter2@localhost:5432/taler-exchange"
+
+[taler-exchange-secmod-rsa]
+lookahead_sign = "1 year"
+overlap_duration = "1 year"
+
+[taler-exchange-secmod-eddsa]
+lookahead_sign = "1 year"
+overlap_duration = "1 year"
+
+[coin_kudo_1]
+value= EUR:0.01
+duration_withdraw= "1 year"
+duration_spend= "1 year"
+duration_legal= "1 year"
+fee_withdraw= EUR:0.00
+fee_deposit= EUR:0.00
+fee_refresh= EUR:0.00
+fee_refund= EUR:0.00
+cipher= RSA
+rsa_keysize= 2048
+age_restricted= NO
+
+[coin_kudo_2]
+value= EUR:0.02
+duration_withdraw= "1 year"
+duration_spend= "1 year"
+duration_legal= "1 year"
+fee_withdraw= EUR:0.00
+fee_deposit= EUR:0.00
+fee_refresh= EUR:0.00
+fee_refund= EUR:0.00
+cipher= RSA
+rsa_keysize= 2048
+age_restricted= NO
diff --git a/.jjconflict-side-0/default/assets/privacy/en/0.md b/.jjconflict-side-0/default/assets/privacy/en/0.md
new file mode 100644
index 00000000..9c8e6b15
--- /dev/null
+++ b/.jjconflict-side-0/default/assets/privacy/en/0.md
@@ -0,0 +1,8 @@
+# Privacy Policy
+
+Welcome!
+This is a placeholder Privacy Policy file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/assets/privacy/en/0.txt b/.jjconflict-side-0/default/assets/privacy/en/0.txt
new file mode 100644
index 00000000..9c8e6b15
--- /dev/null
+++ b/.jjconflict-side-0/default/assets/privacy/en/0.txt
@@ -0,0 +1,8 @@
+# Privacy Policy
+
+Welcome!
+This is a placeholder Privacy Policy file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/assets/terms/en/0.md b/.jjconflict-side-0/default/assets/terms/en/0.md
new file mode 100644
index 00000000..033a5937
--- /dev/null
+++ b/.jjconflict-side-0/default/assets/terms/en/0.md
@@ -0,0 +1,8 @@
+# Terms of Service
+
+Welcome!
+This is a placeholder Terms of Service file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/assets/terms/en/0.txt b/.jjconflict-side-0/default/assets/terms/en/0.txt
new file mode 100644
index 00000000..033a5937
--- /dev/null
+++ b/.jjconflict-side-0/default/assets/terms/en/0.txt
@@ -0,0 +1,8 @@
+# Terms of Service
+
+Welcome!
+This is a placeholder Terms of Service file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-0/default/master_offline_private_key b/.jjconflict-side-0/default/master_offline_private_key
new file mode 100644
index 00000000..739df007
Binary files /dev/null and b/.jjconflict-side-0/default/master_offline_private_key differ
diff --git a/.jjconflict-side-0/dune-project b/.jjconflict-side-0/dune-project
new file mode 100644
index 00000000..1aadd32c
--- /dev/null
+++ b/.jjconflict-side-0/dune-project
@@ -0,0 +1,45 @@
+(lang dune 3.20)
+
+(name mte)
+
+(generate_opam_files true)
+
+; (source
+; (github username/reponame))
+
+(authors "Olivier Pierre ")
+
+(maintainers "Olivier Pierre ")
+
+(license AGPL-3.0-only)
+
+; (documentation https://url/to/documentation)
+
+(package
+ (name mte)
+ (synopsis "MTE - the MirageOS Taler Exchange")
+ (description "A GNU Taler exchange implementation with the unikernel framework MirageOS")
+ (tags
+ ("GNU Taler" MirageOS unikernel OCaml crypto))
+ (depends
+ (ocaml (>= 5.3))
+ base32
+ caqti
+ caqti-miou
+ caqti-driver-pgx
+ crunch
+ vif
+ jsont
+ cohttp
+ fmt
+ bin
+ angstrom
+ mirage-crypto
+ digestif
+ duration
+ jsont
+ cohttp
+ ptime
+ logs
+ (ocamlformat :with-dev-setup)
+ ))
diff --git a/.jjconflict-side-0/mte.opam b/.jjconflict-side-0/mte.opam
new file mode 100644
index 00000000..53820528
--- /dev/null
+++ b/.jjconflict-side-0/mte.opam
@@ -0,0 +1,48 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "MTE - the MirageOS Taler Exchange"
+description:
+ "A GNU Taler exchange implementation with the unikernel framework MirageOS"
+maintainer: ["Olivier Pierre "]
+authors: ["Olivier Pierre "]
+license: "AGPL-3.0-only"
+tags: ["GNU Taler" "MirageOS" "unikernel" "OCaml" "crypto"]
+depends: [
+ "dune" {>= "3.20"}
+ "ocaml" {>= "5.3"}
+ "base32"
+ "caqti"
+ "caqti-miou"
+ "caqti-driver-pgx"
+ "crunch"
+ "vif"
+ "jsont"
+ "cohttp"
+ "fmt"
+ "bin"
+ "angstrom"
+ "mirage-crypto"
+ "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/secrets/.keep b/.jjconflict-side-0/secrets/.keep
new file mode 100644
index 00000000..e69de29b
diff --git a/.jjconflict-side-0/src/amount.ml b/.jjconflict-side-0/src/amount.ml
new file mode 100644
index 00000000..c5e06082
--- /dev/null
+++ b/.jjconflict-side-0/src/amount.ml
@@ -0,0 +1,127 @@
+(* TODO
+ have a currency agnostic amount_lib.ml
+ and specialize amount.ml to Config.currency??
+
+ have safe amount arithmetic *)
+type sign =
+ | Sign_plus
+ | Sign_minus
+
+type t = {
+ sign: sign option;
+ currency: string;
+ value: Int64.t;
+ fraction: Int32.t;
+}
+
+let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
+
+(* TODO
+ the constraint is on the number of digits,
+ so this wrong if leading 0s
+ this depends on currency..? *)
+let fraction_upper_bound = Int32.of_int 100_000_000
+
+let make ~sign ~currency ~value ~fraction =
+ if value < Int64.zero then Error "value is negative"
+ else if fraction < Int32.zero then Error "fraction is negative"
+ else if value > value_upper_bound then Error "value is greater than 2^52-1"
+ else if fraction >= fraction_upper_bound then
+ Error "fraction has more than 8 decimal digits"
+ else Ok { sign; currency; value; fraction }
+
+module Parse = struct
+ open Angstrom
+
+ let sign =
+ char '+' *> return (Some Sign_plus)
+ <|> char '-' *> return (Some Sign_minus)
+ <|> return None
+
+ let currency =
+ take_while1 (function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false)
+ >>= fun s ->
+ match String.length s < 12 with
+ | false -> fail "currency is more than 11 characters"
+ | true -> return s
+
+ let int64 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int64.of_string_opt
+ >>= function
+ | None -> fail "value is not a valid int64"
+ | Some n when n >= value_upper_bound -> fail "value is greater than 2^52-1"
+ | Some n -> return n
+
+ let int32 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int32.of_string_opt
+ >>= function
+ | None -> fail "fraction is not a valid int32"
+ | Some n when n >= fraction_upper_bound ->
+ fail "fraction is greater than 10^8-1"
+ | Some n -> return n
+
+ let amount =
+ lift4
+ (fun sign currency value fraction ->
+ make ~sign ~currency ~value ~fraction)
+ sign currency
+ (char ':' *> int64)
+ (char '.' *> int32 <|> return 0_l)
+ <* end_of_input
+
+ let f s = parse_string ~consume:Consume.All amount s |> Result.join
+end
+
+let of_string = Parse.f
+
+let pp =
+ let open Fmt in
+ let pp_sign ppf = function
+ | Sign_plus -> char ppf '+'
+ | Sign_minus -> char ppf '-'
+ in
+ fun ppf { sign; currency; value; fraction } ->
+ (* TODO
+ depends on the currency's number of fraction digits
+ assumes value and fraction are in bounds *)
+ pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction
+
+let to_string = Fmt.str "%a" pp
+
+(* - *)
+
+let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
+
+(* byte length of currency string *)
+let currency_len = 12
+
+let pad_currency_string s =
+ let len = String.length s in
+ assert (len < currency_len);
+ let b = Bytes.make 12 '\x00' in
+ Bytes.blit_string s 0 b 0 len;
+ Bytes.to_string b
+
+(* binary decoding unused? *)
+let make_exn value fraction currency =
+ match make ~sign:None ~currency ~value ~fraction with
+ | Error _ -> Fmt.failwith "Amount of binary data failure"
+ | Ok v -> v
+
+let bin =
+ let open Bin in
+ record make_exn
+ |+ field neint64 (fun t -> t.value)
+ |+ field neint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
+ |> sealr
+
+let bin_nbo =
+ let open Bin in
+ record make_exn
+ |+ field beint64 (fun t -> t.value)
+ |+ field beint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
+ |> sealr
diff --git a/.jjconflict-side-0/src/amount.mli b/.jjconflict-side-0/src/amount.mli
new file mode 100644
index 00000000..f055430c
--- /dev/null
+++ b/.jjconflict-side-0/src/amount.mli
@@ -0,0 +1,27 @@
+type sign =
+ | Sign_plus
+ | Sign_minus
+
+type t = private {
+ sign: sign option;
+ currency: string;
+ value: Int64.t;
+ fraction: Int32.t;
+}
+
+val make :
+ sign:sign option ->
+ currency:string ->
+ value:Int64.t ->
+ fraction:Int32.t ->
+ (t, string) result
+
+val pp : Format.formatter -> t -> unit
+val to_string : t -> string
+val of_string : string -> (t, string) result
+
+(* - *)
+val jsont : t Jsont.t
+val bin : t Bin.t
+val bin_nbo : t Bin.t
+(* [caqti] is in pg_type.ml *)
diff --git a/.jjconflict-side-0/src/api.ml b/.jjconflict-side-0/src/api.ml
new file mode 100644
index 00000000..c57643d1
--- /dev/null
+++ b/.jjconflict-side-0/src/api.ml
@@ -0,0 +1,1374 @@
+(* 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 jsont const string
+ `name: "taler-exchange"` *)
+ name: string;
+ implementation: string option;
+ currency: string;
+ shopping_url: string option;
+ open_banking_gateway: string option;
+ currency_specification: CurrencySpecification.t;
+ aml_spa_dialect: string option;
+ }
+
+ let jsont =
+ let make version name implementation currency shopping_url
+ open_banking_gateway currency_specification aml_spa_dialect =
+ {
+ version;
+ name;
+ implementation;
+ currency;
+ shopping_url;
+ open_banking_gateway;
+ currency_specification;
+ aml_spa_dialect;
+ }
+ in
+ let version v = v.version in
+ let name v = v.name in
+ let implementation v = v.implementation in
+ let currency v = v.currency in
+ let shopping_url v = v.shopping_url in
+ let open_banking_gateway v = v.open_banking_gateway in
+ let currency_specification v = v.currency_specification in
+ let aml_spa_dialect v = v.aml_spa_dialect in
+ map ~kind:"ExchangeVersionResponse" make
+ |> mem "version" Jsont.string ~enc:version
+ |> mem "name" Jsont.string ~enc:name
+ |> mem "implementation" (Jsont.option Jsont.string) ~enc:implementation
+ |> mem "currency" Jsont.string ~enc:currency
+ |> mem "shopping_url" (Jsont.option Jsont.string) ~enc:shopping_url
+ |> mem "open_banking_gateway"
+ (Jsont.option Jsont.string)
+ ~enc:open_banking_gateway
+ |> mem "currency_specification" CurrencySpecification.jsont
+ ~enc:currency_specification
+ |> mem "aml_spa_dialect" (Jsont.option Jsont.string) ~enc:aml_spa_dialect
+ |> finish
+end
+
+let config =
+ let currency_specification =
+ let open Config.Currency in
+ let alt_unit_names =
+ Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+ in
+ CurrencySpecification.
+ {
+ name= v.name;
+ num_fractional_input_digits= v.fractional_input_digits;
+ num_fractional_normal_digits= v.fractional_normal_digits;
+ num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits;
+ alt_unit_names;
+ common_amounts= [];
+ }
+ in
+ ExchangeVersionResponse.
+ {
+ version= protocol_version;
+ name= "taler-exchange";
+ currency= Config.currency;
+ currency_specification;
+ implementation= None;
+ shopping_url= None;
+ open_banking_gateway= None;
+ aml_spa_dialect= None;
+ }
+
+module RsaDenominationKey = struct
+ type t = {
+ age_mask: int;
+ rsa_pub: RsaPublicKey.t;
+ }
+
+ let jsont =
+ let make age_mask rsa_pub = { age_mask; rsa_pub } in
+ let age_mask v = v.age_mask in
+ let rsa_pub v = v.rsa_pub in
+ Jsont.Object.map ~kind:"RsaDenominationKey" make
+ |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask
+ |> Jsont.Object.mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
+ |> Jsont.Object.finish
+end
+
+(* ! Clause Schnorr cipher is not supported *)
+module DenominationKey = struct
+ type t = Rsa of RsaDenominationKey.t
+
+ let to_octets = function Rsa denom -> RsaPublicKey.to_octets denom.rsa_pub
+
+ let of_cs _v =
+ Jsont.Error.msg Jsont.Meta.none "CSDenominationKey are not supported"
+
+ let of_rsa v = Rsa v
+
+ let jsont =
+ let rsa = Case.map "RSA" RsaDenominationKey.jsont ~dec:of_rsa in
+ let cs = Case.map "CS" zero ~dec:of_cs in
+ let enc_case = function Rsa v -> Case.value rsa v in
+ let cases = Case.[ make rsa; make cs ] in
+ map ~kind:"DenominationKey" Fun.id
+ |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
+ |> finish
+end
+
+module FutureSignKey = struct
+ type t = {
+ key: EddsaPublicKey.t;
+ stamp_start: Timestamp.t;
+ stamp_expire: Timestamp.t;
+ stamp_end: Timestamp.t;
+ signkey_secmod_sig: SigningKeyAnnouncement.t;
+ }
+
+ let jsont =
+ let make key stamp_start stamp_expire stamp_end signkey_secmod_sig =
+ { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+ in
+ let key v = v.key in
+ let stamp_start v = v.stamp_start in
+ let stamp_expire v = v.stamp_expire in
+ let stamp_end v = v.stamp_end in
+ let signkey_secmod_sig v = v.signkey_secmod_sig in
+ map ~kind:"FutureSignKey" make
+ |> mem "key" EddsaPublicKey.jsont ~enc:key
+ |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+ |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
+ |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
+ |> mem "signkey_secmod_sig" SigningKeyAnnouncement.jsont
+ ~enc:signkey_secmod_sig
+ |> finish
+end
+
+module FutureDenom = struct
+ type t = {
+ section_name: string;
+ value: Amount.t;
+ stamp_start: Timestamp.t;
+ stamp_expire_withdraw: Timestamp.t;
+ stamp_expire_deposit: Timestamp.t;
+ stamp_expire_legal: Timestamp.t;
+ denom_pub: DenominationKey.t;
+ fee_withdraw: Amount.t;
+ fee_deposit: Amount.t;
+ fee_refresh: Amount.t;
+ fee_refund: Amount.t;
+ denom_secmod_sig: DenominationKeyAnnouncement.t;
+ }
+
+ let jsont =
+ let make section_name value stamp_start stamp_expire_withdraw
+ stamp_expire_deposit stamp_expire_legal denom_pub fee_withdraw
+ fee_deposit fee_refresh fee_refund denom_secmod_sig =
+ {
+ section_name;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig;
+ }
+ in
+ let section_name t = t.section_name in
+ let value t = t.value in
+ let stamp_start t = t.stamp_start in
+ let stamp_expire_withdraw t = t.stamp_expire_withdraw in
+ let stamp_expire_deposit t = t.stamp_expire_deposit in
+ let stamp_expire_legal t = t.stamp_expire_legal in
+ let denom_pub t = t.denom_pub in
+ let fee_withdraw t = t.fee_withdraw in
+ let fee_deposit t = t.fee_deposit in
+ let fee_refresh t = t.fee_refresh in
+ let fee_refund t = t.fee_refund in
+ let denom_secmod_sig t = t.denom_secmod_sig in
+ map ~kind:"FutureDenom" make
+ |> mem "section_name" Jsont.string ~enc:section_name
+ |> mem "value" Amount.jsont ~enc:value
+ |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+ |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
+ |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
+ |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
+ |> mem "denom_pub" DenominationKey.jsont ~enc:denom_pub
+ |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
+ |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
+ |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
+ |> mem "fee_refund" Amount.jsont ~enc:fee_refund
+ |> mem "denom_secmod_sig" DenominationKeyAnnouncement.jsont
+ ~enc:denom_secmod_sig
+ |> finish
+end
+
+module FutureKeysResponse = struct
+ type t = {
+ future_denoms: FutureDenom.t list;
+ future_signkeys: FutureSignKey.t list;
+ master_pub: EddsaPublicKey.t;
+ denom_secmod_public_key: EddsaPublicKey.t;
+ signkey_secmod_public_key: EddsaPublicKey.t;
+ }
+
+ let jsont =
+ let make future_denoms future_signkeys master_pub denom_secmod_public_key
+ signkey_secmod_public_key =
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub;
+ denom_secmod_public_key;
+ signkey_secmod_public_key;
+ }
+ in
+ let future_denoms t = t.future_denoms in
+ let future_signkeys t = t.future_signkeys in
+ let master_pub t = t.master_pub in
+ let denom_secmod_public_key t = t.denom_secmod_public_key in
+ let signkey_secmod_public_key t = t.signkey_secmod_public_key in
+ map ~kind:"FutureKeysResponse" make
+ |> mem "future_denoms" (Jsont.list FutureDenom.jsont) ~enc:future_denoms
+ |> mem "future_signkeys"
+ (Jsont.list FutureSignKey.jsont)
+ ~enc:future_signkeys
+ |> mem "master_pub" EddsaPublicKey.jsont ~enc:master_pub
+ |> mem "denom_secmod_public_key" EddsaPublicKey.jsont
+ ~enc:denom_secmod_public_key
+ |> mem "signkey_secmod_public_key" EddsaPublicKey.jsont
+ ~enc:signkey_secmod_public_key
+ |> finish
+end
+
+module SignKeySignature = struct
+ type t = {
+ key: EddsaPublicKey.t;
+ master_sig: ExchangeSigningKeyValidity.t;
+ }
+
+ let jsont =
+ let make key master_sig = { key; master_sig } in
+ let key v = v.key in
+ let master_sig v = v.master_sig in
+ map ~kind:"SignKeySignature" make
+ |> mem "key" EddsaPublicKey.jsont ~enc:key
+ |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
+ |> finish
+end
+
+module DenomSignature = struct
+ type t = {
+ h_denom_pub: DenominationHash.t;
+ master_sig: DenominationKeyValidity.t;
+ }
+
+ let jsont =
+ let make h_denom_pub master_sig = { h_denom_pub; master_sig } in
+ let h_denom_pub v = v.h_denom_pub in
+ let master_sig v = v.master_sig in
+ map ~kind:"DenomSignature" make
+ |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub
+ |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
+ |> finish
+end
+
+module MasterSignatures = struct
+ type t = {
+ denom_sigs: DenomSignature.t list;
+ signkey_sigs: SignKeySignature.t list;
+ }
+
+ let jsont =
+ let make denom_sigs signkey_sigs = { denom_sigs; signkey_sigs } in
+ let denom_sigs v = v.denom_sigs in
+ let signkey_sigs v = v.signkey_sigs in
+ map ~kind:"MasterSignatures" make
+ |> mem "denom_sigs" (Jsont.list DenomSignature.jsont) ~enc:denom_sigs
+ |> mem "signkey_sigs" (Jsont.list SignKeySignature.jsont) ~enc:signkey_sigs
+ |> finish
+end
+
+module DenomRevocationSignature = struct
+ type t = { master_sig: MasterDenominationKeyRevocation.t }
+
+ let jsont =
+ let make master_sig = { master_sig } in
+ let enc v = v.master_sig in
+ map ~kind:"DenomRevocationSignature" make
+ |> mem "master_sig" MasterDenominationKeyRevocation.jsont ~enc
+ |> finish
+end
+
+module SignkeyRevocationSignature = struct
+ type t = { master_sig: MasterSigningKeyRevocation.t }
+
+ let jsont =
+ let make master_sig = { master_sig } in
+ let enc v = v.master_sig in
+ map ~kind:"SignkeyRevocationSignature" make
+ |> mem "master_sig" MasterSigningKeyRevocation.jsont ~enc
+ |> finish
+end
+
+module AuditorSetupMessage = struct
+ type t = {
+ auditor_url: string;
+ auditor_name: string;
+ auditor_pub: EddsaPublicKey.t;
+ master_sig: MasterAddAuditor.t;
+ (* 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/src/assets.ml b/.jjconflict-side-0/src/assets.ml
similarity index 100%
rename from src/assets.ml
rename to .jjconflict-side-0/src/assets.ml
diff --git a/.jjconflict-side-0/src/b32.ml b/.jjconflict-side-0/src/b32.ml
new file mode 100644
index 00000000..6bd06400
--- /dev/null
+++ b/.jjconflict-side-0/src/b32.ml
@@ -0,0 +1,38 @@
+(* Crockford's variant of Base32
+ http://www.crockford.com/wrmg/base32.html
+ except that:
+ - 'U' is not excluded but also decodes to 'V'
+ - '-' is not allowed
+ - checksum is not allowed *)
+
+(* 'I' 'L' 'O' 'U' excluded
+ no '=' padding in encoded string *)
+type t = string
+
+let alphabet = Base32.make_alphabet "0123456789ABCDEFGHJKMNPQRSTVWXYZ"
+
+let encode s =
+ let s = Base32.encode_string ~alphabet s in
+ (* remove '=' padding *)
+ match String.index_opt s '=' with
+ | None -> s
+ | Some i -> String.sub s 0 i
+
+let decode s =
+ let s =
+ String.map
+ (fun c ->
+ match Char.uppercase_ascii c with
+ | 'O' -> '0'
+ | 'I' | 'L' -> '1'
+ | 'U' -> 'V'
+ | c -> c)
+ s
+ in
+ (* restore padding for base32 lib *)
+ let n = 8 - (String.length s mod 8) in
+ let pad = String.make n '=' in
+ let s = s ^ pad in
+ match Base32.decode ~alphabet ~off:0 ~len:(String.length s) s with
+ | Error (`Msg e) -> Error e
+ | Ok v -> Ok v
diff --git a/.jjconflict-side-0/src/config.ml b/.jjconflict-side-0/src/config.ml
new file mode 100644
index 00000000..3ccc104b
--- /dev/null
+++ b/.jjconflict-side-0/src/config.ml
@@ -0,0 +1,202 @@
+open Parse_config
+
+let config_filename = "mte.conf"
+let secrets_dir = Fpath.v "secrets"
+
+let config_data =
+ match Assets_crunch.read config_filename with
+ | None -> fail "static file not found: `%s`" config_filename
+ | Some data ->
+ let v = Config_section.parse data in
+ v
+
+module Exchange = struct
+ let get_opt field = get_opt config_data ~section:"exchange" ~field
+ let get field = get config_data ~section:"exchange" ~field
+
+ (* - *)
+ let currency = (* todo: constraint on currency string *) get "currency"
+ let currency_round_unit = get "currency_round_unit" |> amount
+ let db = get "db" |> const_value "postgres"
+ let attribute_encryption_key = get "attribute_encryption_key"
+ let port = get "port" |> int
+ let bind_to = get "bind_to"
+ let master_public_key = get "master_public_key" |> ed25519
+
+ (* TODO Defaults to 0.0 if not specified. *)
+ let stefan_abs = get "stefan_abs" |> amount
+ let stefan_log = get "stefan_log" |> amount
+
+ let stefan_lin =
+ get_opt "stefan_lin" |> Option.map float |> Option.value ~default:0.0
+
+ let aggregator_idle_sleep_interval =
+ get "aggregator_idle_sleep_interval" |> duration
+
+ let closer_idle_sleep_interval = get "closer_idle_sleep_interval" |> duration
+
+ let transfer_idle_sleep_interval =
+ get "transfer_idle_sleep_interval" |> duration
+
+ let wirewatch_idle_sleep_interval =
+ get "wirewatch_idle_sleep_interval" |> duration
+
+ let signkey_legal_duration = get "signkey_legal_duration" |> duration
+ let max_keys_caching = get "max_keys_caching" |> duration
+ let enable_kyc = get "enable_kyc" |> yes_no
+ let terms_etag = get "terms_etag" |> etag
+ let privacy_etag = get "privacy_etag" |> etag
+ let base_url = get "base_url"
+ let shopping_url = get_opt "shopping_url"
+ let open_banking_gateway_url = get_opt "open_banking_gateway_url"
+ let bank_compliance_language = get_opt "bank_compliance_language"
+ let aml_spa_dialect = get_opt "aml_spa_dialect"
+ let toplevel_redirect_url = get_opt "toplevel_redirect_url"
+ let tiny_amount = get_opt "tiny_amount" |> Option.map amount
+
+ (* not implemented or not relevant to MTE:
+ let max_requests = get "max_requests" |> int
+ aggregator_shard_size
+ serve
+ unixpath
+ unixpath_mode
+ terms_dir
+ privacy_dir *)
+end
+
+module Exchangedb = struct
+ let get field = get config_data ~section:"exchangedb" ~field
+
+ (* - *)
+ let idle_reserve_expiration_time =
+ get "idle_reserve_expiration_time" |> duration
+
+ let legal_reserve_expiration_time =
+ get "legal_reserve_expiration_time" |> duration
+
+ let aggregator_shift = get "aggregator_shift" |> duration
+ let max_aml_program_runtime = get "max_aml_program_runtime" |> duration
+ let default_purse_limit = get "default_purse_limit" |> int
+end
+
+module Exchangedb_postgres = struct
+ let config =
+ get config_data ~section:"exchangedb-postgres" ~field:"config" |> uri
+end
+
+module Currency = struct
+ type t = {
+ enabled: [ `YES | `NO ];
+ code: string;
+ name: string;
+ fractional_input_digits: int;
+ fractional_normal_digits: int;
+ fractional_trailing_zero_digits: int;
+ alt_unit_names: (int * string) list;
+ }
+
+ let currency_sections =
+ List.filter
+ (fun v -> String.starts_with ~prefix:"currency-" v.header)
+ config_data
+
+ let parse_currency section =
+ let get field = get config_data ~section:section.header ~field in
+ {
+ enabled= get "enabled" |> yes_no;
+ code= get "code";
+ name= get "name";
+ fractional_input_digits= get "fractional_input_digits" |> int;
+ fractional_normal_digits= get "fractional_normal_digits" |> int;
+ fractional_trailing_zero_digits=
+ get "fractional_trailing_zero_digits" |> int;
+ alt_unit_names=
+ get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap;
+ }
+
+ let all_currencies = List.map parse_currency currency_sections
+
+ (* I think the exchange only handle one currency *)
+ let v =
+ match
+ List.find_opt (fun v -> v.code = Exchange.currency) all_currencies
+ with
+ | None ->
+ fail "section `[currency-%s]` not found, currency `%s` is not defined"
+ Exchange.currency Exchange.currency
+ | Some v -> (
+ match v.enabled = `YES with
+ | false -> fail "currency `%s` is not enabled" Exchange.currency
+ | true -> v)
+end
+
+module Coin = struct
+ type t = {
+ section_name: string;
+ value: Amount.t;
+ duration_withdraw: Time.Relative.t;
+ duration_spend: Time.Relative.t;
+ duration_legal: Time.Relative.t;
+ fee_withdraw: Amount.t;
+ fee_deposit: Amount.t;
+ fee_refresh: Amount.t;
+ fee_refund: Amount.t;
+ cipher: [ (* `CS |*) `RSA ];
+ rsa_keysize: int; (* : int option (only if `RSA) *)
+ age_restricted: [ (*`YES|*) `NO ];
+ }
+
+ let coin_sections =
+ List.filter
+ (fun v ->
+ (* note: here its a '_' not '-' *)
+ String.starts_with ~prefix:"coin_" v.header)
+ config_data
+
+ let parse_coin section =
+ let get field = get config_data ~section:section.header ~field in
+ let section_name =
+ String.sub section.header 5 (String.length section.header - 5)
+ in
+ {
+ section_name;
+ value= get "value" |> amount;
+ duration_withdraw= get "duration_withdraw" |> duration;
+ duration_spend= get "duration_spend" |> duration;
+ duration_legal= get "duration_legal" |> duration;
+ fee_withdraw= get "fee_withdraw" |> amount;
+ fee_deposit= get "fee_deposit" |> amount;
+ fee_refresh= get "fee_refresh" |> amount;
+ fee_refund= get "fee_refund" |> amount;
+ cipher= (get "cipher" |> const_value "RSA" |> fun _s -> `RSA);
+ rsa_keysize= get "rsa_keysize" |> int;
+ age_restricted=
+ ( get "age_restricted" |> yes_no |> function
+ | `NO -> `NO
+ | `YES -> fail "`age_restricted = YES` is not supported" );
+ }
+
+ let all_coins = List.map parse_coin coin_sections
+end
+
+module Exchange_secmod_rsa = struct
+ let get field =
+ let section = "taler-exchange-secmod-" ^ "rsa" in
+ get config_data ~section ~field
+
+ let lookahead_sign = get "lookahead_sign" |> duration
+ let overlap_duration = get "overlap_duration" |> duration
+ (* not relevant: sm_priv_key key_dir unixpath *)
+end
+
+module Exchange_secmod_eddsa = struct
+ let get field =
+ let section = "taler-exchange-secmod-" ^ "eddsa" in
+ get config_data ~section ~field
+
+ let lookahead_sign = get "lookahead_sign" |> duration
+ let overlap_duration = get "overlap_duration" |> duration
+end
+
+(* -- *)
+include Exchange
diff --git a/.jjconflict-side-0/src/crypto.ml b/.jjconflict-side-0/src/crypto.ml
new file mode 100644
index 00000000..bf437fce
--- /dev/null
+++ b/.jjconflict-side-0/src/crypto.ml
@@ -0,0 +1,300 @@
+open Syntax
+
+module Binary_format_rsa = struct
+ (* TODO tests:
+ - need to strip leading zeros?
+ - endianess ok? *)
+ (* RSA public key binary format
+ https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html
+ := { uint16_be: n size; uint16_be: e size; n; e}
+
+ integer in big-endian format (MSB first)
+ leading zeroes are stripped unless they are required to keep a value positive
+ no 0-termination *)
+
+ let rev_string len s = String.init len (fun i -> s.[len - 1 - i])
+
+ (* we reverse bytes because Z.of_bits reads bytes in little endian *)
+ let z_of_bits_be src pos len =
+ String.sub src pos len |> rev_string len |> Z.of_bits
+
+ let z_to_bits_be z =
+ let bits = Z.to_bits z in
+ rev_string (String.length bits) bits
+
+ let z_array_to_octets (arr : Z.t array) =
+ let nb = Array.length arr in
+ let bits_arr = Array.map z_to_bits_be arr in
+ let len_arr = Array.map String.length bits_arr in
+ let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
+ let b = Bytes.make len '\x00' in
+ let pos = ref 0 in
+ Array.iter
+ (fun len ->
+ Bytes.set_uint16_be b !pos len;
+ pos := !pos + 2)
+ len_arr;
+ Array.iteri
+ (fun i bits ->
+ let len = len_arr.(i) in
+ Bytes.blit_string bits 0 b !pos len;
+ pos := !pos + len)
+ bits_arr;
+ Bytes.unsafe_to_string b
+
+ let check = function
+ | false -> Error "rsa of_octets error, invalid data"
+ | true -> Ok ()
+
+ let z_array_of_octets ~nb s =
+ let s_len = String.length s in
+ let* () = check (s_len > 2 * nb) in
+ let pos = ref 0 in
+ let len_arr =
+ Array.init nb (fun _i ->
+ let len = String.get_uint16_be s !pos in
+ pos := !pos + 2;
+ len)
+ in
+ let* () =
+ let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
+ check (s_len = len)
+ in
+ let z_arr =
+ Array.init nb (fun i ->
+ let len = len_arr.(i) in
+ let z = z_of_bits_be s !pos len in
+ pos := !pos + len;
+ z)
+ in
+ Ok z_arr
+
+ let pub_to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) =
+ z_array_to_octets [| n; e |]
+
+ let pub_of_octets s =
+ let* arr = z_array_of_octets ~nb:2 s in
+ match arr with
+ | [| n; e |] ->
+ let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg in
+ pub
+ | _ -> assert false
+
+ let priv_to_octets ({ e; d; n; p; q; dp; dq; q' } : Mirage_crypto_pk.Rsa.priv)
+ =
+ z_array_to_octets [| e; d; n; p; q; dp; dq; q' |]
+
+ let priv_of_octets s =
+ let* arr = z_array_of_octets ~nb:8 s in
+ match arr with
+ | [| e; d; n; p; q; dp; dq; q' |] ->
+ let+ priv =
+ Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_err_msg
+ in
+ priv
+ | _ -> assert false
+end
+
+(* TODO key format
+ - check what is the exact format in GNUNET
+ - endianess issue? *)
+module EddsaPublicKey = struct
+ (* EdDSA and ECDHE public keys always point on Curve25519
+ and represented using the standard 256 bits Ed25519 compact format,
+ converted to Crockford Base32. *)
+ open Mirage_crypto_ec.Ed25519
+
+ type t = pub
+
+ let to_octets t = pub_to_octets t
+
+ let of_octets t =
+ pub_of_octets t |> function
+ | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
+ | Ok v -> Ok v
+
+ let bin =
+ let of_octets_exn t = of_octets t |> Result.get_ok in
+ Bin.map (Bin.bytes 32) of_octets_exn to_octets
+
+ let of_b32 s =
+ let* octets = B32.decode s in
+ let* pub = of_octets octets in
+ Ok pub
+
+ let to_b32 t = B32.encode (to_octets t)
+ let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
+
+ let caqti =
+ Caqti_type.custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> of_octets v)
+ Caqti_type.octets
+end
+
+module EddsaPrivateKey = struct
+ (* EdDSA and ECDHE public keys always point on Curve25519
+ and represented using the standard 256 bits Ed25519 compact format,
+ converted to Crockford Base32. *)
+ open Mirage_crypto_ec.Ed25519
+
+ type t = priv
+
+ let pub_of_priv = pub_of_priv
+ let to_octets t = priv_to_octets t
+
+ let of_octets t =
+ priv_of_octets t |> function
+ | Error err ->
+ let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in
+ Error err
+ | Ok v -> Ok v
+
+ let bin =
+ let of_octets_exn t = of_octets t |> Result.get_ok in
+ Bin.map (Bin.bytes 32) of_octets_exn to_octets
+
+ let jsont =
+ let of_b32 s =
+ let* octets = B32.decode s in
+ of_octets octets
+ in
+ let to_b32 t = B32.encode (to_octets t) in
+ Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
+end
+
+module EddsaSignature : sig
+ type t
+
+ val sign : key:EddsaPrivateKey.t -> string -> t
+
+ (* Ok () on verification success *)
+ val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result
+ val to_octets : t -> string
+ val of_octets : string -> (t, string) result
+ val jsont : t Jsont.t
+ val bin : t Bin.t
+ val caqti : t Caqti_type.t
+end = struct
+ (* TODO key format
+ endianess issue? *)
+ (* transmitted as 64-bytes base32
+ binary-encoded objects with just the R and S values *)
+ type t = string
+
+ (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)
+ let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s
+
+ let verify ~key s ~msg =
+ let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in
+ match b with
+ | false -> Error "signature verification failure: invalid signature"
+ | true -> Ok ()
+
+ let to_octets t = t
+
+ let of_octets v =
+ match String.length v = 64 with
+ | false ->
+ Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
+ | true -> Ok v
+
+ let bin =
+ let of_octets_exn t = of_octets t |> Result.get_ok in
+ Bin.map (Bin.bytes 64) of_octets_exn to_octets
+
+ let check_size t =
+ match String.length t = 64 with
+ | false -> Error "EddsaSignature: invalid string length"
+ | true -> Ok ()
+
+ let jsont =
+ let of_b32 s =
+ let* t = B32.decode s in
+ let+ () = check_size t in
+ t
+ in
+ let to_b32 = B32.encode in
+ Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
+
+ let caqti =
+ Caqti_type.custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun s -> of_octets s)
+ Caqti_type.octets
+end
+
+module RsaPublicKey = struct
+ open Mirage_crypto_pk
+
+ type t = Rsa.pub
+
+ let to_octets = Binary_format_rsa.pub_to_octets
+ let of_octets = Binary_format_rsa.pub_of_octets
+
+ let jsont =
+ let of_b32 s =
+ let* s = B32.decode s in
+ let+ v = of_octets s in
+ v
+ in
+ let to_b32 t = B32.encode (to_octets t) in
+ Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
+
+ let caqti : t Caqti_type.t =
+ Caqti_type.custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> of_octets v)
+ Caqti_type.octets
+end
+
+module RsaPrivateKey = struct
+ open Mirage_crypto_pk.Rsa
+
+ type t = priv
+
+ let generate ~bits () =
+ let priv = generate ~bits () in
+ let pub = pub_of_priv priv in
+ (priv, pub)
+
+ let pub_of_priv = pub_of_priv
+ let of_octets = Binary_format_rsa.priv_of_octets
+ let to_octets = Binary_format_rsa.priv_to_octets
+
+ let jsont =
+ let of_b32 s =
+ let* s = B32.decode s in
+ let+ v = of_octets s in
+ v
+ in
+ let to_b32 t = B32.encode (to_octets t) in
+ Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
+end
+
+module RsaSignature : sig
+ type t
+
+ val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t
+ val jsont : t Jsont.t
+end = struct
+ type t = string
+
+ (* TODO rsa sign *)
+ let sign ~key s =
+ Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s
+
+ let jsont =
+ let of_b32 s = B32.decode s in
+ let to_b32 t = B32.encode t in
+ Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
+end
+
+(* some type aliases, just for prettier .mli *)
+type eddsa_priv = EddsaPrivateKey.t
+type eddsa_pub = EddsaPublicKey.t
+type eddsa_sig = EddsaSignature.t
+type rsa_priv = RsaPrivateKey.t
+type rsa_pub = RsaPublicKey.t
+type rsa_sig = RsaSignature.t
+type denomination_hash = Hash.DenominationHash.t
diff --git a/.jjconflict-side-0/src/data_file.ml b/.jjconflict-side-0/src/data_file.ml
new file mode 100644
index 00000000..9fa34674
--- /dev/null
+++ b/.jjconflict-side-0/src/data_file.ml
@@ -0,0 +1,35 @@
+open Bos.OS
+open Syntax
+open Crypto
+
+let read fname =
+ let* b = File.exists fname |> Syntax.unwrap_err_msg in
+ match b with
+ | false -> Ok None
+ | true ->
+ let+ content = File.read fname |> Syntax.unwrap_err_msg in
+ Some content
+
+let write_eddsa fname priv =
+ EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let write_rsa fname priv =
+ RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let read_eddsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ EddsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
+
+let read_rsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ RsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
diff --git a/.jjconflict-side-0/src/denom_data.ml b/.jjconflict-side-0/src/denom_data.ml
new file mode 100644
index 00000000..7d94367d
--- /dev/null
+++ b/.jjconflict-side-0/src/denom_data.ml
@@ -0,0 +1,18 @@
+open Crypto
+
+type t = {
+ pub: rsa_pub;
+ value: Amount.t;
+ stamp_start: Timestamp.t;
+ stamp_expire_withdraw: Timestamp.t;
+ stamp_expire_deposit: Timestamp.t;
+ stamp_expire_legal: Timestamp.t;
+ fee_withdraw: Amount.t;
+ fee_deposit: Amount.t;
+ fee_refresh: Amount.t;
+ fee_refund: Amount.t;
+ age_mask: int;
+ h_pub: denomination_hash;
+ master_sig: Signatures.DenominationKeyValidity.t option;
+ revoked_sig: Signatures.MasterDenominationKeyRevocation.t option;
+}
diff --git a/.jjconflict-side-0/src/devices.ml b/.jjconflict-side-0/src/devices.ml
new file mode 100644
index 00000000..7da26428
--- /dev/null
+++ b/.jjconflict-side-0/src/devices.ml
@@ -0,0 +1,26 @@
+type env = {
+ caqti_switch: Caqti_miou.Switch.t;
+ db_uri: Uri.t;
+}
+
+let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
+ let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
+ Vif.Device.v ~name:"db_connection" ~finally []
+ @@ fun { caqti_switch; db_uri } ->
+ match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
+ | Error err ->
+ Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
+ | Ok conn -> (
+ match Pg.preflight conn with
+ | Error err ->
+ Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
+ | Ok () ->
+ Logs.info (fun m -> m "database connection initialized");
+ conn)
+
+let secmod =
+ let finally _key = () in
+ Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
+ @@ fun (module Conn : Pg.CONN) (_env : env) ->
+ let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in
+ sm
diff --git a/.jjconflict-side-0/src/dune b/.jjconflict-side-0/src/dune
new file mode 100644
index 00000000..a9322eed
--- /dev/null
+++ b/.jjconflict-side-0/src/dune
@@ -0,0 +1,44 @@
+(executable
+ (public_name mte)
+ (name mte)
+ (modules mte)
+ (libraries mte))
+
+(library
+ (name mte)
+ (wrapped false)
+ (modules :standard \ mte b32)
+ (libraries
+ b32
+ ;
+ caqti
+ caqti-miou
+ caqti-miou.unix
+ caqti-driver-pgx
+ bin
+ mirage-crypto
+ digestif
+ duration
+ vif
+ fmt
+ jsont
+ cohttp
+ ptime
+ logs
+ logs.fmt
+ logs.threaded
+ fmt.tty))
+
+(library ; crockford base32
+ (name b32)
+ (modules b32)
+ (libraries base32))
+
+(rule
+ (target assets_crunch.ml)
+ (deps
+ (source_tree ../assets))
+ (action
+ (with-stdout-to
+ %{null}
+ (run ocaml-crunch -m plain ../assets -o %{target}))))
diff --git a/.jjconflict-side-0/src/hash.ml b/.jjconflict-side-0/src/hash.ml
new file mode 100644
index 00000000..0da809df
--- /dev/null
+++ b/.jjconflict-side-0/src/hash.ml
@@ -0,0 +1,104 @@
+(* TODO use SHA512.of_raw_string_opt *)
+open Digestif
+
+module type S = sig
+ type t
+
+ val bin : t Bin.t
+ val caqti : t Caqti_type.t
+ val jsont : t Jsont.t
+ val hash : string -> t
+ val of_octets : string -> t
+ val to_octets : t -> string
+ val of_b32 : B32.t -> (t, string) result
+end
+
+module H32 = struct
+ type t = SHA256.t
+
+ let hash s = SHA256.(digest_string s)
+
+ let of_octets s =
+ match SHA256.of_raw_string_opt s with
+ | None -> Fmt.failwith "H32.of_octets failure: data is not 32 bytes"
+ | Some t -> t
+
+ let to_octets = SHA256.to_raw_string
+ let of_b32 s = Result.map of_octets (B32.decode s)
+
+ let bin =
+ let open Bin in
+ map (bytes 32) of_octets to_octets
+
+ (* hashes are not b32 encoded in the database *)
+ let caqti =
+ let open Caqti_type in
+ custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> Ok (of_octets v))
+ octets
+
+ let jsont =
+ let enc v = B32.encode (to_octets v) in
+ Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc
+end
+
+module H64 = struct
+ type t = SHA512.t
+
+ let hash s = SHA512.(digest_string s)
+
+ let of_octets s =
+ match SHA512.of_raw_string_opt s with
+ | None -> Fmt.failwith "H64.of_octets failure: data is not 64 bytes"
+ | Some t -> t
+
+ let to_octets = SHA512.to_raw_string
+ let of_b32 s = Result.map of_octets (B32.decode s)
+
+ let bin =
+ let open Bin in
+ map (bytes 64) of_octets to_octets
+
+ (* hashes are not b32 encoded in the database *)
+ let caqti =
+ let open Caqti_type in
+ custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> Ok (of_octets v))
+ octets
+
+ let jsont =
+ let enc v = B32.encode (to_octets v) in
+ Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc
+end
+
+(* C-terminated strings
+ some strings need to be hashed with a '\0' termination char *)
+module Cstring = struct
+ module H32 = struct
+ include H32
+
+ let hash s = hash (s ^ "\x00")
+ end
+
+ module H64 = struct
+ include H64
+
+ let hash s = hash (s ^ "\x00")
+ end
+end
+
+(* TODO
+ check which hash algorithm to use for each hash type *)
+module FullPaytoHash : S = H32
+module NormalizedPaytoHash : S = H32
+module DenominationHash : S = H64
+module PrivateContractHash : S = H64
+module ExtensionsPolicyHash : S = H64
+module MerchantWireHash : S = H64
+module AgeCommitmentHash : S = H64
+module BlindedCoinHash : S = H64
+module CoinPubHash : S = H64
+module OutputCommitmentHash : S = H64
+module HashPlanchetsP : S = H64
diff --git a/.jjconflict-side-0/src/headers.ml b/.jjconflict-side-0/src/headers.ml
new file mode 100644
index 00000000..fb2070bc
--- /dev/null
+++ b/.jjconflict-side-0/src/headers.ml
@@ -0,0 +1,48 @@
+(* TODO header
+ Cohttp -> Http *)
+
+let accept_header_value =
+ let pp_list pp_item item = Fmt.list ~sep:(Fmt.any ", ") pp_item item in
+ Fmt.str "%a" (pp_list Assets.Mimetype.pp) Assets.Mimetype.all_supported
+
+let avail_languages_header_value =
+ let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item in
+ let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
+ s
+
+(* TODO Cohttp raises on invalid *)
+let select_mimetype headers =
+ let opt = Vif.Headers.get headers "accept" in
+ Cohttp.Accept.media_ranges opt
+ |> Cohttp.Accept.qsort
+ |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
+ |> function
+ | None -> Assets.default_mimetype
+ | Some mime -> mime
+
+let select_language headers =
+ let opt = Vif.Headers.get headers "accept-language" in
+ Cohttp.Accept.languages opt
+ |> Cohttp.Accept.qsort
+ |> List.map snd
+ |> List.find_map Assets.Language.of_cohttp_language
+ |> function
+ | None -> Assets.default_lang
+ | Some lang -> lang
+
+let select_encoding headers =
+ let opt = Vif.Headers.get headers "accept-encoding" in
+ Cohttp.Accept.encodings opt
+ |> Cohttp.Accept.qsort
+ |> List.map snd
+ |> List.find_map (function
+ | Cohttp.Accept.Identity -> Some `Identity
+ | Deflate -> Some `DEFLATE
+ | Gzip -> Some `Gzip
+ | AnyEncoding -> Some Assets.default_encoding
+ | Encoding _ | Compress -> (* unsupported *) None)
+ |> function
+ | None -> None
+ | Some `Identity -> None
+ | Some `DEFLATE -> Some `DEFLATE
+ | Some `Gzip -> Some `Gzip
diff --git a/.jjconflict-side-0/src/headers_lib.ml b/.jjconflict-side-0/src/headers_lib.ml
new file mode 100644
index 00000000..e76a589a
--- /dev/null
+++ b/.jjconflict-side-0/src/headers_lib.ml
@@ -0,0 +1,69 @@
+module Etag = struct
+ (* https://httpwg.org/specs/rfc9110.html#field.etag *)
+
+ type t = {
+ weak: bool;
+ value: string;
+ }
+
+ let pp ppf { weak; value } =
+ match weak with
+ | false -> Fmt.pf ppf {|"%s"|} value
+ | true -> Fmt.pf ppf {|W/"%s"|} value
+
+ let to_field_string t = Fmt.str "%a" pp t
+
+ let angstrom =
+ let open Angstrom in
+ let is_valid_char c =
+ let n = Char.code c in
+ (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+ in
+ let quoted_string = char '"' *> take_while is_valid_char <* char '"' in
+ lift2
+ (fun weak value -> { weak; value })
+ (option false (string "W/" *> return true))
+ quoted_string
+
+ let parse s =
+ match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+ | Error _e -> Fmt.error "invalid etag: `%s`" s
+ | Ok v -> Ok v
+end
+
+module If_none_match = struct
+ type t =
+ | Any
+ | List of Etag.t list
+
+ let pp ppf = function
+ | Any -> Fmt.pf ppf {|*|}
+ | List l -> Fmt.pf ppf {|%a|} (Fmt.list ~sep:(Fmt.any ", ") Etag.pp) l
+
+ let angstrom =
+ let open Angstrom in
+ let ows = skip_while (function ' ' | '\t' -> true | _ -> false) in
+ let comma = ows *> char ',' *> ows in
+ (* A recipient MUST parse and ignore a reasonable number of empty list elements *)
+ let etag_opt = Etag.angstrom >>| Option.some <|> return None in
+ let etags =
+ etag_opt >>= fun hd ->
+ many (comma *> etag_opt) >>= fun tl ->
+ let l = List.filter_map Fun.id (hd :: tl) in
+ match l with [] -> fail "empty etag list" | l -> return (List l)
+ in
+ let any = char '*' *> return Any in
+ any <|> etags
+
+ let parse s =
+ match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+ | Error _e -> Fmt.error "invalid if-none-match field: `%s`" s
+ | Ok v -> Ok v
+
+ let evaluate etag t =
+ match t with
+ | Any -> false
+ | List l ->
+ not
+ @@ List.exists (fun e -> String.equal etag.Etag.value e.Etag.value) l
+end
diff --git a/.jjconflict-side-0/src/http_information.ml b/.jjconflict-side-0/src/http_information.ml
new file mode 100644
index 00000000..79ac240e
--- /dev/null
+++ b/.jjconflict-side-0/src/http_information.ml
@@ -0,0 +1,279 @@
+open Syntax
+open Api
+module String_map = Stdlib.Map.Make (Stdlib.String)
+
+(* TODO mirage-crypto
+ is this ok?
+ maybe don't use the same RNG-initialization as the one used to generate keys *)
+let seed req _server _env =
+ Logs.info (fun m -> m "GET /seed");
+ (* RNG is initialized by Vif.run *)
+ let s = Mirage_crypto_rng.generate 64 in
+ let open Vif.Response in
+ let open Syntax in
+ let* () = add ~field:"content-type" "application/octet-stream" in
+ let* () = with_string req s in
+ respond `OK
+
+let config req _server _env =
+ Logs.info (fun m -> m "GET /config");
+ let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in
+ Respond_util.respond_with_ok_json s req
+
+(* TODO
+ for now we only have one item in each "denom group"
+ change this once we have denom/signkey rotation *)
+let denomgroup_of_denomdata
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask= _;
+ h_pub= _;
+ master_sig;
+ revoked_sig= _;
+ } =
+ let master_sig = match master_sig with None -> assert false | Some v -> v in
+ let denoms =
+ [
+ RsaDenom.
+ {
+ rsa_pub= pub;
+ master_sig;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ lost= None;
+ };
+ ]
+ in
+ DenomGroup.Rsa
+ RsaDenomGroup.
+ { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
+
+let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
+ let version = Api.protocol_version in
+ let base_url = Config.base_url in
+ let currency = Config.currency in
+ let shopping_url = Config.shopping_url in
+ let open_banking_gateway = Config.open_banking_gateway_url in
+ let bank_compliance_language = Config.bank_compliance_language in
+ let currency_specification =
+ let v = Config.Currency.v in
+ let alt_unit_names =
+ Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+ in
+ CurrencySpecification.
+ {
+ name= v.name;
+ num_fractional_input_digits= v.fractional_input_digits;
+ num_fractional_normal_digits= v.fractional_normal_digits;
+ num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits;
+ alt_unit_names;
+ common_amounts= [];
+ }
+ in
+ let tiny_amount = Config.tiny_amount in
+ let stefan_abs = Config.stefan_abs in
+ let stefan_log = Config.stefan_log in
+ let stefan_lin = Config.stefan_lin in
+ (* todo asset_type
+ Type of the asset. "fiat", "crypto", "regional" or "stock". *)
+ let asset_type = "xxx" in
+ let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in
+ let* wire_fees =
+ (* todo
+ where does wire_methods comes from? *)
+ let wire_method = "xxx" in
+ let+ wire_fees =
+ Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti
+ in
+ String_map.singleton wire_method wire_fees
+ in
+ let wads =
+ (* TODO wads *)
+ []
+ in
+ let rewards_allowed = false in
+ let kyc_enabled = false in
+ let disable_direct_deposit = (* todo *) false in
+ let master_public_key = Config.master_public_key in
+ let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in
+ (* todo *)
+ let wallet_balance_limit_without_kyc = None in
+ let hard_limits = [] in
+ let zero_limits = [] in
+ let denom_data_l =
+ (* TODO sm-db *)
+ (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
+ Sm.get_denoms_data ()
+ in
+ let denom_data_l =
+ (* reverse chronological order *)
+ List.sort
+ (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start)
+ denom_data_l
+ in
+ let list_issue_date =
+ match denom_data_l with
+ | [] -> Time.Timestamp.never
+ | v :: _ -> v.Denom_data.stamp_start
+ in
+ let denominations =
+ let open Denom_data in
+ (* if `?last_issue_date` query param does not exactly match the `stamp_start`
+ of one of the denomination keys, all keys are returned *)
+ let l =
+ match last_issue_date with
+ | None -> denom_data_l
+ | Some last_issue_date -> (
+ match
+ List.find_opt
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date = 0)
+ denom_data_l
+ with
+ | None -> denom_data_l
+ | Some _ ->
+ List.filter
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
+ denom_data_l)
+ in
+ List.map denomgroup_of_denomdata l
+ in
+
+ let signkeys =
+ (* TODO sm-db
+ use database signkey data / verify secmod and database are in sync *)
+ (*
+ let now = Ptime_clock.now () |> Option.some in
+ let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
+ let signkey_data_l = Sm.get_signkeys_data () in
+ let signkey_data_l =
+ List.sort
+ (fun a b ->
+ let open Signkey_data in
+ Stdlib.compare b.stamp_start a.stamp_start)
+ signkey_data_l
+ in
+ List.filter_map
+ (fun Signkey_data.
+ {
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig;
+ revoked_sig= _;
+ } ->
+ match master_sig with
+ | None -> None
+ | Some master_sig ->
+ Some
+ SignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; master_sig })
+ signkey_data_l
+ in
+
+ let exchange_pub =
+ (* the eddsa pub key used to sign exchange_sig *)
+ match signkeys with
+ | [] -> Fmt.failwith "exchange has no active signkey"
+ | v :: _ -> v.SignKey.key
+ in
+ let exchange_sig =
+ (* Compact EdDSA signature (binary-only) over the
+ contatentation of all of the master_sigs (in reverse
+ chronological order by group) in the arrays under "denominations". *)
+ let hc =
+ denom_data_l
+ |> List.filter_map (fun v -> v.Denom_data.master_sig)
+ |> List.map Signatures.DenominationKeyValidity.to_octets
+ |> String.concat ""
+ |> Hash.H64.hash
+ in
+ let open Signatures.ExchangeKeySet in
+ sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc }
+ in
+
+ let recoup = (* TODO /recoup *) [] in
+ let* global_fees =
+ Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti
+ in
+ let* auditors =
+ (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *)
+ (* does not contains auditor_keys with empty denomination_keys *)
+ Pg.get_auditor_keys db_conn
+ in
+ let extensions = None in
+ let extensions_sig = None in
+ Ok
+ ExchangeKeysResponse.
+ {
+ version;
+ base_url;
+ currency;
+ shopping_url;
+ open_banking_gateway;
+ bank_compliance_language;
+ currency_specification;
+ tiny_amount;
+ stefan_abs;
+ stefan_log;
+ stefan_lin;
+ asset_type;
+ accounts;
+ wire_fees;
+ wads;
+ rewards_allowed;
+ kyc_enabled;
+ disable_direct_deposit;
+ master_public_key;
+ reserve_closing_delay;
+ wallet_balance_limit_without_kyc;
+ hard_limits;
+ zero_limits;
+ denominations;
+ exchange_sig;
+ exchange_pub;
+ recoup;
+ global_fees;
+ list_issue_date;
+ auditors;
+ signkeys;
+ extensions;
+ extensions_sig;
+ }
+
+let jsont = ExchangeKeysResponse.jsont
+
+let keys req server _env =
+ Logs.info (fun m -> m "GET /keys");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* last_issue_date =
+ match Vif.Queries.get req "last_issue_date" with
+ | [] -> Ok None
+ | v :: _ -> (
+ match int_of_string_opt v with
+ | None ->
+ Error
+ "invalid `?last_issue_date` query param, int_of_string failure"
+ | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n))))
+ in
+ let* v = mk_keys ~db_conn sm ~last_issue_date in
+ let s = Api.encode_exn jsont v in
+ Ok s
+ in
+ Respond_util.respond_with_res res req
diff --git a/.jjconflict-side-0/src/http_management.ml b/.jjconflict-side-0/src/http_management.ml
new file mode 100644
index 00000000..29b08016
--- /dev/null
+++ b/.jjconflict-side-0/src/http_management.ml
@@ -0,0 +1,743 @@
+open Syntax
+open Api
+open Hash
+
+module Keys_get = struct
+ let mk_future_denom (module Sm : Secmod.S) ~section_name
+ ({
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig= _;
+ revoked_sig= _;
+ } :
+ Denom_data.t) =
+ let denom_pub =
+ DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub }
+ in
+ let denom_secmod_sig =
+ let open Signatures.DenominationKeyAnnouncement in
+ let h_denom_pub = h_pub in
+ let h_section_name = Hash.Cstring.H64.hash section_name in
+ let anchor_time = stamp_start in
+ let duration_withdraw =
+ Timestamp.diff stamp_start stamp_expire_withdraw
+ in
+ sign_f ~f:Sm.sign_with_sm_key
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+ in
+ FutureDenom.
+ {
+ section_name;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig;
+ }
+
+ let mk_future_signkey (module Sm : Secmod.S)
+ ({
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig= _;
+ revoked_sig= _;
+ } :
+ Signkey_data.t) =
+ let signkey_secmod_sig =
+ let open Signatures.SigningKeyAnnouncement in
+ let exchange_pub = pub in
+ let anchor_time = stamp_start in
+ let duration = Timestamp.diff stamp_start stamp_expire in
+ sign_f ~f:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration }
+ in
+ FutureSignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+
+ let mk_future_keys_response (module Sm : Secmod.S) =
+ let future_signkeys =
+ Sm.get_signkeys_data ()
+ |> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig)
+ |> List.map (fun signkey -> mk_future_signkey (module Sm) signkey)
+ in
+ let future_denoms =
+ Sm.get_denoms_data ()
+ |> List.filter (fun k -> Option.is_none k.Denom_data.master_sig)
+ |> List.map (fun dn_data ->
+ let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in
+ match opt with
+ | None -> Fmt.failwith "section_name not found."
+ | Some section_name ->
+ mk_future_denom (module Sm) ~section_name dn_data)
+ in
+ let master_pub = Config.Exchange.master_public_key in
+ let denom_secmod_public_key = Sm.get_sm_key_pub () in
+ let signkey_secmod_public_key = Sm.get_sm_key_pub () in
+ FutureKeysResponse.
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub;
+ denom_secmod_public_key;
+ signkey_secmod_public_key;
+ }
+
+ let jsont = FutureKeysResponse.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "GET /management/keys/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let v = mk_future_keys_response sm in
+ let s = Api.encode_exn jsont v in
+ Ok s
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Keys_post = struct
+ let verify_denom_signature (module Sm : Secmod.S)
+ DenomSignature.{ h_denom_pub; master_sig } =
+ let* denom =
+ match Sm.find_denom_data h_denom_pub with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some denom -> Ok denom
+ in
+ let open Signatures.DenominationKeyValidity in
+ let r : r =
+ {
+ master= Config.master_public_key;
+ start= denom.stamp_start;
+ expire_withdraw= denom.stamp_expire_withdraw;
+ expire_spend= denom.stamp_expire_deposit;
+ expire_legal= denom.stamp_expire_legal;
+ value= denom.value;
+ fee_withdraw= denom.fee_withdraw;
+ fee_deposit= denom.fee_deposit;
+ fee_refresh= denom.fee_refresh;
+ fee_refund= denom.fee_refund;
+ denom_hash= h_denom_pub;
+ }
+ in
+ verify_f ~f:Sm.verify_with_master_key master_sig r
+
+ let verify_signkey_signature (module Sm : Secmod.S)
+ SignKeySignature.{ key; master_sig } =
+ let* signkey =
+ match Sm.find_signkey_data key with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some signkey -> Ok signkey
+ in
+ let open Signatures.ExchangeSigningKeyValidity in
+ let r : r =
+ {
+ start= signkey.stamp_start;
+ expire= signkey.stamp_expire;
+ end_= signkey.stamp_end;
+ signkey_pub= signkey.pub;
+ }
+ in
+ verify_f ~f:Sm.verify_with_master_key master_sig r
+
+ let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } =
+ let* () = list_iter (verify_denom_signature sm) denom_sigs in
+ let* () = list_iter (verify_signkey_signature sm) signkey_sigs in
+ Ok ()
+
+ (* TODO move to test *)
+ let check_master_signatures_update ~db_conn (module Sm : Secmod.S) =
+ Sm.get_denoms_data ()
+ |> list_iter (fun denom ->
+ let error = Error "update_master_signatures sanity check failure" in
+ let* opt =
+ Pg.find_denom db_conn denom.Denom_data.h_pub |> unwrap_err_caqti
+ in
+ let* v = match opt with None -> error | Some v -> Ok v in
+ let check = function false -> error | true -> Ok () in
+ let* () =
+ check (Timestamp.compare v.stamp_start denom.stamp_start = 0)
+ in
+ let* () = check (v.value = denom.value) in
+ let* () = check (v.fee_refund = denom.fee_refund) in
+ let* () = check (v.age_mask = denom.age_mask) in
+ Ok ())
+
+ let do_ ~db_conn (module Sm : Secmod.S)
+ MasterSignatures.{ denom_sigs; signkey_sigs } =
+ let* () =
+ signkey_sigs
+ |> List.map (fun SignKeySignature.{ key; master_sig } ->
+ (key, master_sig))
+ |> Sm.add_signkey_master_signatures
+ in
+ let* () =
+ denom_sigs
+ |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
+ (h_denom_pub, master_sig))
+ |> Sm.add_denom_master_signatures
+ in
+ let* () = Sm.store () in
+ let* () = check_master_signatures_update ~db_conn (module Sm) in
+ Ok ()
+
+ let jsont = MasterSignatures.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/keys/");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn sm v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Denom_revoke = struct
+ let verify (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let open Signatures.MasterDenominationKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let* () = Sm.revoke_denomination h_denom_pub master_sig in
+ let+ () =
+ Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
+ |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = DenomRevocationSignature.jsont
+
+ let f req h_denom_pub server _env =
+ Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm h_denom_pub v in
+ let* () = do_ ~db_conn sm h_denom_pub v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Signkey_revoke = struct
+ let verify (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let open Signatures.MasterSigningKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let* () = Sm.revoke_signkey exchange_pub master_sig in
+ let+ () =
+ Pg.insert_signkey_revocation db_conn exchange_pub master_sig
+ |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = SignkeyRevocationSignature.jsont
+
+ let f req exchange_pub server _env =
+ Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm exchange_pub v in
+ let* () = do_ ~db_conn sm exchange_pub v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Auditors = struct
+ let verify (module Sm : Secmod.S)
+ AuditorSetupMessage.
+ {
+ auditor_url;
+ auditor_name= _;
+ auditor_pub;
+ master_sig;
+ validity_start;
+ } =
+ let open Signatures.MasterAddAuditor in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date= validity_start;
+ auditor_pub;
+ h_auditor_url= Hash.Cstring.H64.hash auditor_url;
+ }
+
+ (* TODO timestamps last_change +/- checks *)
+ (* todo: there is something about use of monotonic time
+ + protection against replay attack that I don't understand *)
+ let do_ ~db_conn v =
+ let auditor_pub = v.AuditorSetupMessage.auditor_pub in
+ let validity_start = v.AuditorSetupMessage.validity_start in
+ let* last_date_opt =
+ Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+ in
+ match last_date_opt with
+ | None ->
+ let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "enabled auditor");
+ ()
+ | Some last_date ->
+ if Timestamp.compare last_date validity_start > 0 then
+ Error
+ "database has more recent auditor data for this auditor public key"
+ else
+ let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "updated auditor");
+ ()
+
+ let jsont = AuditorSetupMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/auditors/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Auditors_disable = struct
+ let verify (module Sm : Secmod.S) auditor_pub
+ AuditorTeardownMessage.{ master_sig; validity_end } =
+ let open Signatures.MasterDelAuditor in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ { end_date= validity_end; auditor_pub }
+
+ let do_ ~db_conn auditor_pub
+ AuditorTeardownMessage.{ master_sig= _; validity_end } =
+ let* last_date_opt =
+ Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+ in
+ match last_date_opt with
+ | None -> Error "auditor not found"
+ | Some last_date ->
+ if Timestamp.compare last_date validity_end > 0 then
+ Error
+ "database has more recent auditor data for this auditor public key"
+ else
+ let+ () =
+ Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
+ |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = AuditorTeardownMessage.jsont
+
+ let f req auditor_pub server _env =
+ Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm auditor_pub v in
+ let* () = do_ ~db_conn auditor_pub v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Wire_fee = struct
+ let verify (module Sm : Secmod.S)
+ WireFeeSetupMessage.
+ {
+ wire_method;
+ master_sig_wire;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ } =
+ let open Signatures.MasterWireFee in
+ verify_f ~f:Sm.verify_with_master_key master_sig_wire
+ {
+ h_wire_method= Hash.Cstring.H64.hash wire_method;
+ start_date= fee_start;
+ end_date= fee_end;
+ wire_fee;
+ closing_fee;
+ }
+
+ let do_ ~db_conn (v : WireFeeSetupMessage.t) =
+ let* wire_fees =
+ Pg.get_wire_fees_by_time db_conn ~wire_method:v.wire_method
+ ~start_date:v.fee_start ~end_date:v.fee_end
+ |> unwrap_err_caqti
+ in
+ match wire_fees with
+ | [] ->
+ let+ () = Pg.insert_wire_fee db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "added wire fee");
+ ()
+ | [ vv ] -> (
+ match v.master_sig_wire = vv.sig_ with
+ | false ->
+ Error "a different wire-fee was already setup for this time frame"
+ | true ->
+ Logs.info (fun m -> m "an identical wire-fee was already setup");
+ Ok ())
+ | _ ->
+ Error
+ "invalid database state, multiple wire-fee found in database for \
+ this time frame"
+
+ let jsont = WireFeeSetupMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/wire-fee/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Global_fees = struct
+ let verify (module Sm : Secmod.S)
+ GlobalFees.
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ } =
+ let open Signatures.GlobalFees in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ }
+
+ let do_ ~db_conn v =
+ let* global_fees =
+ let start_date = v.GlobalFees.start_date in
+ let end_date = v.GlobalFees.end_date in
+ Pg.get_global_fees_by_time db_conn ~start_date ~end_date
+ |> unwrap_err_caqti
+ in
+ match global_fees with
+ | [] ->
+ let+ () = Pg.insert_global_fees db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "added global fees");
+ ()
+ | [ vv ] -> (
+ match v.master_sig = vv.master_sig with
+ | false ->
+ Error
+ "a different global-fees was already setup for this time frame"
+ | true ->
+ Logs.info (fun m -> m "an identical global-fees was already setup");
+ Ok ())
+ | _ ->
+ Error
+ "invalid database state, multiple global-fees found in database for \
+ this time frame"
+
+ let jsont = GlobalFees.jsont
+
+ (* TODO global_fees
+ ensure it is defined for the current time.
+ there should be only one global_fees for each moment in time
+ and once set for a timeframe, it should not change. *)
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/global-fees/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Wire = struct
+ let verify (module Sm : Secmod.S)
+ WireSetupMessage.
+ {
+ payto_uri;
+ master_sig_wire;
+ master_sig_add;
+ validity_start;
+ bank_label= _;
+ priority= _;
+ } =
+ (* TODO wire *)
+ let conversion_url = "" in
+ let credit_restrictions = "" in
+ let debit_restrictions = "" in
+ let* () =
+ let open Signatures.MasterWireDetails in
+ verify_f ~f:Sm.verify_with_master_key master_sig_wire
+ {
+ h_wire_details= FullPaytoHash.hash payto_uri;
+ h_conversion_url= Hash.Cstring.H64.hash conversion_url;
+ h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
+ h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
+ }
+ in
+ let* () =
+ let open Signatures.MasterAddWire in
+ verify_f ~f:Sm.verify_with_master_key master_sig_add
+ {
+ start_date= validity_start;
+ h_wire= FullPaytoHash.hash payto_uri;
+ h_conversion_url= Hash.Cstring.H64.hash conversion_url;
+ h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
+ h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
+ }
+ in
+ Ok ()
+
+ let do_ ~db_conn v =
+ let* last_change_opt =
+ let payto_uri = v.WireSetupMessage.payto_uri in
+ Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+ in
+ match last_change_opt with
+ | Some _ -> Error "wire already setup"
+ | None ->
+ (* TODO wire *)
+ let last_change = Timestamp.of_ptime (Ptime_clock.now ()) in
+ let v =
+ ExchangeWireAccount.
+ {
+ payto_uri= v.payto_uri;
+ conversion_url= None;
+ debit_restrictions= [];
+ credit_restrictions= [];
+ master_sig= v.master_sig_wire;
+ bank_label= v.bank_label;
+ priority= v.priority;
+ }
+ in
+ let+ () = Pg.insert_wire db_conn ~last_change v |> unwrap_err_caqti in
+ ()
+
+ let jsont = WireSetupMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/wire/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Wire_disable = struct
+ let verify (module Sm : Secmod.S)
+ WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
+ let open Signatures.MasterDelWire in
+ verify_f ~f:Sm.verify_with_master_key master_sig_del
+ { end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri }
+
+ let do_ ~db_conn
+ WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
+ let* last_change_opt =
+ Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+ in
+ match last_change_opt with
+ | None -> Error "wire not found"
+ | Some _ ->
+ let+ () =
+ Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = WireTeardownMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/wire/disable/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Drain = struct
+ let verify (module Sm : Secmod.S)
+ DrainProfitsMessage.
+ {
+ debit_account_section;
+ credit_payto_uri;
+ wtid;
+ master_sig;
+ date;
+ amount;
+ } =
+ let open Signatures.MasterDrainProfit in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ wtid;
+ date;
+ amount;
+ h_section= Hash.Cstring.H64.hash debit_account_section;
+ h_payto= FullPaytoHash.hash credit_payto_uri;
+ }
+
+ let do_ ~db_conn v =
+ let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
+ ()
+
+ let jsont = DrainProfitsMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/drain/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module AmlOfficer = struct
+ let verify (module Sm : Secmod.S)
+ AmlOfficerSetup.
+ {
+ officer_pub;
+ officer_name;
+ is_active;
+ read_only= _;
+ master_sig;
+ change_date;
+ } =
+ let open Signatures.MasterAmlOfficerStatus in
+ let is_active = match is_active with true -> 1_l | false -> 0_l in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ change_date;
+ officer_pub;
+ h_officer_name= Hash.Cstring.H64.hash officer_name;
+ is_active;
+ }
+
+ let do_ ~db_conn v =
+ let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_err_caqti in
+ ()
+
+ let jsont = AmlOfficerSetup.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/aml-officers/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Partners = struct
+ let verify (module Sm : Secmod.S)
+ ExchangePartnerSetupRequest.
+ {
+ partner_base_url;
+ partner_pub;
+ wad_frequency;
+ master_sig;
+ start_date;
+ end_date;
+ wad_fee;
+ } =
+ let open Signatures.PartnerConfiguration in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ partner_pub;
+ start_date;
+ end_date;
+ wad_frequency;
+ wad_fee;
+ h_url= Hash.Cstring.H64.hash partner_base_url;
+ }
+
+ let do_ ~db_conn v =
+ let+ () = Pg.insert_partner db_conn v |> unwrap_err_caqti in
+ ()
+
+ let jsont = ExchangePartnerSetupRequest.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/partners/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
diff --git a/.jjconflict-side-0/src/mte.ml b/.jjconflict-side-0/src/mte.ml
new file mode 100644
index 00000000..abfc68a8
--- /dev/null
+++ b/.jjconflict-side-0/src/mte.ml
@@ -0,0 +1,83 @@
+(* 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 / "seed") --> Http_information.seed;
+ get_ (rel / "config") --> Http_information.config;
+ get_ (rel / "keys") --> Http_information.keys;
+ ]
+ in
+ let management =
+ let open Http_management in
+ let v s = rel / "management" / s in
+ [
+ get_ (v "keys") --> Keys_get.f;
+ post (v "keys") Keys_post.jsont --> Keys_post.f;
+ post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
+ --> Denom_revoke.f;
+ post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont
+ --> Signkey_revoke.f;
+ post (v "auditors") Auditors.jsont --> Auditors.f;
+ post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont
+ --> Auditors_disable.f;
+ post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f;
+ post (v "global-fees") Global_fees.jsont --> Global_fees.f;
+ post (v "wire") Wire.jsont --> Wire.f;
+ post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f;
+ post (v "drain") Drain.jsont --> Drain.f;
+ post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f;
+ post (v "partners") Partners.jsont --> Partners.f;
+ ]
+ in
+ tos @ status_info @ management
+
+let () =
+ Util.Log_reporter.setup ();
+ let cfg =
+ let port = Config.Exchange.port in
+ let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+ Vif.config ~reporter:Util.Log_reporter.reporter sockaddr
+ in
+ Miou_unix.run @@ fun () ->
+ Caqti_miou.Switch.run @@ fun caqti_switch ->
+ let env : Devices.env =
+ { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
+ in
+ let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in
+ let middlewares = Vif.Middlewares.[] in
+ Logs.info (fun m ->
+ m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
+ Vif.run ~cfg ~devices ~middlewares routes env
diff --git a/.jjconflict-side-0/src/parse_config.ml b/.jjconflict-side-0/src/parse_config.ml
new file mode 100644
index 00000000..86254830
--- /dev/null
+++ b/.jjconflict-side-0/src/parse_config.ml
@@ -0,0 +1,232 @@
+(* rudimentary configuration file parser (INI-like)
+ https://docs.taler.net/manpages/taler-exchange.conf.5.html
+
+ do not support "$"-path expansion *)
+
+open Angstrom
+
+type item = {
+ key: string;
+ value: string;
+}
+
+type section = {
+ header: string;
+ items: item list;
+}
+
+let fail fmt =
+ let k _ppf = exit 1 in
+ Fmt.kpf k Fmt.stderr ("Configuration failure: " ^^ fmt ^^ ".@.")
+
+let is_eol = function '\n' | '\r' -> true | _ -> false
+let is_whitespace = function ' ' | '\t' -> true | _ -> false
+let blanks = skip_while is_whitespace
+
+module Config_section = struct
+ type t =
+ | Blank
+ | Comment of string
+ | Header of string
+ | Item of item
+
+ let id =
+ let ident_char = function
+ | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
+ | _ -> false
+ in
+ take_while1 ident_char >>| String.lowercase_ascii
+
+ let line = take_till is_eol <* end_of_line
+ let blank_line = blanks <* end_of_line >>| fun () -> Blank
+ let comment = blanks *> (char '#' <|> char '%') *> line >>| fun s -> Comment s
+
+ let header =
+ blanks *> char '[' *> id <* char ']' <* blanks <* end_of_line >>| fun s ->
+ Header s
+
+ let item_value =
+ let unquoted_value =
+ take_while1 (fun c -> not (is_whitespace c || is_eol c))
+ <* blanks
+ <* end_of_line
+ in
+ let quoted_value =
+ char '"' *> take_till is_eol <* end_of_line >>= fun s ->
+ match String.ends_with ~suffix:"\"" s && s <> "\"" with
+ | false -> fail "invalid quoted value"
+ | true ->
+ let value = String.sub s 0 (String.length s - 1) in
+ return value
+ in
+ quoted_value <|> unquoted_value
+
+ let item =
+ lift2
+ (fun key value -> Item { key; value })
+ id
+ (blanks *> char '=' *> blanks *> item_value)
+
+ let config =
+ many (choice [ blank_line; comment; header; item ]) <* end_of_input
+
+ let fold_sections l =
+ let rec loop section_l item_l l =
+ match l with
+ | [] ->
+ if List.is_empty item_l then section_l
+ else fail "invalid configuration structure"
+ | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
+ | Item item :: tl -> loop section_l (item :: item_l) tl
+ | Header header :: tl ->
+ let section = { header; items= item_l } in
+ loop (section :: section_l) [] tl
+ in
+ loop [] [] (List.rev l)
+
+ let parse s =
+ match parse_string ~consume:All config s with
+ | Error msg -> fail "parse error `%s`" msg
+ | Ok v -> fold_sections v
+end
+
+module Config_duration = struct
+ type duration_element = {
+ number: int;
+ dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
+ }
+
+ let integer =
+ take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
+ match int_of_string_opt s with
+ | None -> fail "expected integer, got `%s`" s
+ | Some i -> return i
+
+ let duration_element =
+ let number = blanks *> integer in
+ let dunit =
+ blanks *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
+ >>= function
+ | "year" | "years" -> return `Year
+ | "week" | "weeks" -> return `Week
+ | "day" | "days" -> return `Day
+ | "hour" | "hours" -> return `Hour
+ | "minute" | "minutes" -> return `Minute
+ | "second" | "seconds" | "s" -> return `Second
+ | s -> fail "expected a duration unit, got `%s`" s
+ in
+ lift2 (fun number dunit -> { number; dunit }) number dunit
+
+ let duration = many1 duration_element <* end_of_input
+
+ (* TODO put this in Time.Relative *)
+ let dunit_to_seconds u =
+ let rec f = function
+ | `Year -> 365 * f `Day
+ | `Week -> 7 * f `Day
+ | `Day -> 24 * f `Hour
+ | `Hour -> 60 * f `Minute
+ | `Minute -> 60 * f `Second
+ | `Second -> 1
+ in
+ f u
+
+ let to_time_span t =
+ List.fold_left
+ (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
+ 0 t
+ |> Int64.of_int
+ |> Time.Relative.of_s
+
+ let parse s : duration_element list =
+ match parse_string ~consume:All duration s with
+ | Error msg -> fail "duration parse error `%s`" msg
+ | Ok v -> v
+end
+
+let unwrap = function Error e -> fail "`%s`." e | Ok v -> v
+
+let get_opt t ~section ~field =
+ match List.find_opt (fun v -> v.header = section) t with
+ | None -> None
+ | Some v -> (
+ match List.find_opt (fun item -> item.key = field) v.items with
+ | None -> None
+ | Some item -> Some item.value)
+
+let get t ~section ~field =
+ match get_opt t ~section ~field with
+ | None -> fail "option `[%s].%s` not found" section field
+ | Some v -> v
+
+let int s =
+ match int_of_string_opt s with
+ | None -> fail "expected int value, got `%s`" s
+ | Some v -> v
+
+let float s =
+ match float_of_string_opt s with
+ | None -> fail "expected float value, got `%s`" s
+ | Some v -> v
+
+let const_value a b =
+ match a = b with false -> fail "unexpected value `%s`" b | true -> a
+
+let yes_no = function
+ | "NO" -> `NO
+ | "YES" -> `YES
+ | s -> fail "expected `YES`/`NO` value, got `%s`" s
+
+let uri s = Uri.of_string s
+let amount s = s |> Amount.of_string |> unwrap
+let duration s = Config_duration.(s |> parse |> to_time_span)
+
+let ed25519 s =
+ s
+ |> B32.decode
+ |> unwrap
+ |> Mirage_crypto_ec.Ed25519.pub_of_octets
+ |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
+ |> unwrap
+
+let etag s =
+ match Headers_lib.Etag.parse s with
+ | Ok etag -> etag
+ | Error e -> (
+ (* retry with quotes if needed *)
+ match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with
+ | Ok etag -> etag
+ | Error _ -> fail "could not parse etag `%s`: %s" s e)
+
+(* TODO
+ move to another module
+ can we type the json as a Int_map directly? *)
+module Alt_unit_names = struct
+ open Syntax
+ module String_map = Map.Make (String)
+
+ let string_map_jsont = Jsont.Object.as_string_map Jsont.string
+
+ let decode s =
+ let* string_map = Jsont_bytesrw.decode_string string_map_jsont s in
+ let l = String_map.to_list string_map in
+ let* l =
+ list_map
+ (fun (k, v) ->
+ match int_of_string_opt k with
+ | None -> Error "alt_unit_names has a non-integer key"
+ | Some k -> Ok (k, v))
+ l
+ in
+ match List.find_opt (fun (i, _) -> i = 0) l with
+ | None -> Error "alt_unit_names with no entry for base value \"0\""
+ | Some _ -> Ok l
+
+ let encode l =
+ let l = List.map (fun (k, v) -> (string_of_int k, v)) l in
+ let string_map = String_map.of_list l in
+ let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in
+ s
+
+ let encode_exn l = encode l |> Result.get_ok
+end
diff --git a/.jjconflict-side-0/src/pg.ml b/.jjconflict-side-0/src/pg.ml
new file mode 100644
index 00000000..32428045
--- /dev/null
+++ b/.jjconflict-side-0/src/pg.ml
@@ -0,0 +1,374 @@
+(* TODO
+
+ check there is no issues with signed/unsigned integers
+
+ how to fix postgres/caqti tuple type?
+ try something with OID?
+ need to add boilerplate in each query for amounts
+
+ GNU Taler db-events?
+ it seems caqti/pgx does not support it
+
+ transaction
+
+ should check validity of signatures got from db, for /management at least
+
+ clean up caqti error type *)
+(* TODO time
+ fix comparison with timestamp footgun *)
+
+module type CONN = Caqti_miou.CONNECTION
+
+module Caqti_type = struct
+ include Caqti_type
+ include Pg_type
+ include Caqti_request.Infix
+end
+
+open Crypto
+open Api
+
+let preflight =
+ let l =
+ List.map
+ Caqti_type.(unit ->. unit)
+ [
+ "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL \
+ SERIALIZABLE;";
+ "SET enable_sort=OFF;";
+ "SET enable_seqscan=OFF;";
+ "SET enable_mergejoin=OFF;";
+ "SET search_path TO exchange;";
+ ]
+ in
+ fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l
+
+let find_signkey =
+ let find_signkey =
+ Caqti_type.(eddsa_pub ->? signkey_data)
+ "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
+ esk.expire_legal, esk.master_sig, skr.master_sig FROM \
+ exchange_sign_keys AS esk LEFT JOIN signkey_revocations AS skr ON \
+ esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1"
+ in
+ fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
+ Conn.find_opt find_signkey exchange_pub
+
+let get_active_signkeys =
+ let get_active_signkeys =
+ Caqti_type.(time ->* signkey_data)
+ "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
+ esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \
+ WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \
+ signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)"
+ in
+ fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now
+
+(* note: does not update revocation *)
+let insert_signkey =
+ let insert_signkey =
+ Caqti_type.(signkey_data ->. unit)
+ "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
+ expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_signkey v
+
+let find_denom =
+ let find_denom =
+ Caqti_type.(denomination_hash ->? denom_data)
+ "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
+ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
+ (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
+ dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
+ dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
+ = dnr.denominations_serial WHERE dn.denom_pub_hash=$1"
+ in
+ fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub
+
+let get_denominations =
+ let get_denominations =
+ Caqti_type.(unit ->* denom_data)
+ "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
+ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
+ (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
+ dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
+ dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
+ = dnr.denominations_serial"
+ in
+ fun (module Conn : CONN) -> Conn.collect_list get_denominations ()
+
+(* note: does not update revocation *)
+let insert_denom =
+ let insert_denom =
+ Caqti_type.(denom_data ->. unit)
+ "INSERT INTO denominations (denom_pub, coin, valid_from, \
+ expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \
+ fee_deposit, fee_refresh, fee_refund, age_mask, denom_pub_hash, \
+ master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \
+ ($12,$13), ($14,$15), $16, $17, $18)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_denom v
+
+let insert_denomination_revocation =
+ let denomination_revocation_insert =
+ let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in
+ Caqti_type.(t2 denomination_hash master_sig ->. unit)
+ "INSERT INTO denomination_revocations (denominations_serial, master_sig) \
+ SELECT denominations_serial, $2 FROM denominations WHERE \
+ denom_pub_hash=$1"
+ in
+ fun (module Conn : CONN) h_denom_pub master_sig ->
+ Conn.exec denomination_revocation_insert (h_denom_pub, master_sig)
+
+let insert_signkey_revocation =
+ let signkey_revocation_insert =
+ let master_sig = Signatures.MasterSigningKeyRevocation.caqti in
+ Caqti_type.(t2 eddsa_pub master_sig ->. unit)
+ "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \
+ esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1"
+ in
+ fun (module Conn : CONN) exchange_pub master_sig ->
+ Conn.exec signkey_revocation_insert (exchange_pub, master_sig)
+
+let get_auditor_timestamp =
+ let get_auditor_timestamp =
+ Caqti_type.(eddsa_pub ->? time)
+ "SELECT last_change FROM auditors WHERE auditor_pub=$1"
+ in
+ fun (module Conn : CONN) auditor_pub ->
+ Conn.find_opt get_auditor_timestamp auditor_pub
+
+let insert_auditor =
+ let insert_auditor =
+ Caqti_type.(t4 eddsa_pub string string time ->. unit)
+ "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
+ is_active, last_change) VALUES ($1, $2, $3, true, $4)"
+ in
+ fun (module Conn : CONN)
+ AuditorSetupMessage.
+ { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
+ ->
+ Conn.exec insert_auditor
+ (auditor_pub, auditor_name, auditor_url, validity_start)
+
+let update_auditor =
+ let update_auditor =
+ Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
+ "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
+ last_change=$5 WHERE auditor_pub=$1"
+ in
+ fun (module Conn : CONN)
+ AuditorSetupMessage.
+ { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
+ ->
+ Conn.exec update_auditor
+ (auditor_pub, auditor_url, auditor_name, true, validity_start)
+
+let disable_auditor =
+ let update_auditor =
+ Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
+ "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
+ last_change=$5 WHERE auditor_pub=$1"
+ in
+ fun (module Conn : CONN) ~auditor_pub ~change_date ->
+ Conn.exec update_auditor (auditor_pub, "", "", false, change_date)
+
+let insert_auditor_denom_sig =
+ let insert_auditor_denom_sig =
+ let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
+ Caqti_type.(t3 eddsa_pub denomination_hash auditor_sig ->. unit)
+ "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \
+ INSERT INTO auditor_denom_sigs (auditor_uuid, denominations_serial, \
+ auditor_sig) SELECT ax.auditor_uuid, denominations_serial, $3 FROM \
+ denominations CROSS JOIN ax WHERE denom_pub_hash=$2 ON CONFLICT DO \
+ NOTHING"
+ in
+ fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig ->
+ Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig)
+
+(* todo auditors
+ maybe check that url and name are unique/same for each auditor_pub
+ and do the ht logic out of pg.ml? *)
+(* this does not return auditors that are not auditing any denom *)
+let get_auditor_keys =
+ let get_auditor_keys =
+ let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
+ Caqti_type.(
+ unit ->* t5 eddsa_pub string string denomination_hash auditor_sig)
+ "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \
+ ads.auditor_sig FROM auditor_denom_sigs AS ads JOIN auditors AS a USING \
+ (auditor_uuid) JOIN denominations AS dn USING (denominations_serial) \
+ WHERE a.is_active"
+ in
+ fun (module Conn : CONN) ->
+ let open Syntax in
+ let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in
+ let ht = Hashtbl.create 0xff in
+ List.iter
+ (fun (pub, url, name, denom_pub_h, auditor_sig) ->
+ let k = (pub, url, name) in
+ match Hashtbl.find_opt ht k with
+ | None -> Hashtbl.replace ht k [ (denom_pub_h, auditor_sig) ]
+ | Some l -> Hashtbl.replace ht k ((denom_pub_h, auditor_sig) :: l))
+ l;
+ let l = Hashtbl.to_seq ht |> List.of_seq in
+ let l =
+ List.map
+ (fun ((auditor_pub, auditor_url, auditor_name), auditor_denoms) ->
+ let denomination_keys =
+ List.map
+ (fun (denom_pub_h, auditor_sig) ->
+ AuditorDenominationKey.{ denom_pub_h; auditor_sig })
+ auditor_denoms
+ in
+ AuditorKeys.
+ { auditor_pub; auditor_url; auditor_name; denomination_keys })
+ l
+ in
+ Ok l
+
+let insert_wire_fee =
+ let insert_wire_fee =
+ let master_sig = Signatures.MasterWireFee.caqti in
+ Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit)
+ "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \
+ closing_fee, master_sig) VALUES ($1, $2, $3, ($4,$5), ($6,$7), $8)"
+ in
+ fun (module Conn : CONN)
+ WireFeeSetupMessage.
+ {
+ wire_method;
+ master_sig_wire;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ }
+ ->
+ Conn.exec insert_wire_fee
+ (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire)
+
+let get_wire_fees_by_time =
+ let get_wire_fee_by_time =
+ Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee)
+ "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
+ FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \
+ $3"
+ in
+ fun (module Conn : CONN) ~wire_method ~start_date ~end_date ->
+ Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date)
+
+let get_wire_fees =
+ let get_wire_fees =
+ Caqti_type.(string ->* aggregate_transfer_fee)
+ "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
+ FROM wire_fee WHERE wire_method=$1"
+ in
+ fun (module Conn : CONN) ~wire_method ->
+ Conn.collect_list get_wire_fees wire_method
+
+let get_global_fees =
+ let get_global_fees =
+ Caqti_type.(time ->* global_fee)
+ "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
+ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
+ master_sig FROM global_fee WHERE start_date >= $1"
+ in
+ fun (module Conn : CONN) ~start_date ->
+ Conn.collect_list get_global_fees start_date
+
+let get_global_fees_by_time =
+ let get_global_fees_by_time =
+ Caqti_type.(t2 time time ->* global_fee)
+ "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
+ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
+ master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2"
+ in
+ fun (module Conn : CONN) ~start_date ~end_date ->
+ Conn.collect_list get_global_fees_by_time (start_date, end_date)
+
+let insert_global_fees =
+ let insert_global_fees =
+ Caqti_type.(global_fee ->. unit)
+ "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
+ purse_fee, history_expiration, purse_account_limit, purse_timeout, \
+ master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
+ $12)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_global_fees v
+
+let get_wire_timestamp =
+ let get_wire_timestamp =
+ Caqti_type.(payto_uri ->? time)
+ "SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
+ in
+ fun (module Conn : CONN) ~payto_uri ->
+ Conn.find_opt get_wire_timestamp payto_uri
+
+let insert_wire =
+ let insert_wire =
+ Caqti_type.(t3 exchange_wire_account bool time ->. unit)
+ "INSERT INTO wire_accounts (payto_uri, conversion_url, \
+ credit_restrictions, debit_restrictions, master_sig, bank_label, \
+ priority, is_active, last_change) VALUES \
+ ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)"
+ in
+ fun (module Conn : CONN) ~last_change v ->
+ let is_active = true in
+ Conn.exec insert_wire (v, is_active, last_change)
+
+let update_wire =
+ let update_wire =
+ Caqti_type.(t3 exchange_wire_account bool time ->. unit)
+ "UPDATE wire_accounts SET conversion_url=$2, \
+ debit_restrictions=$3::TEXT::JSONB, \
+ credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
+ priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
+ in
+ fun (module Conn : CONN) ~is_active ~last_change v ->
+ Conn.exec update_wire (v, is_active, last_change)
+
+let disable_wire =
+ let disable_wire =
+ (* TODO check syntax on this *)
+ Caqti_type.(t2 payto_uri time ->. unit)
+ "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \
+ credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \
+ priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1"
+ in
+ fun (module Conn : CONN) ~payto_uri ~validity_end ->
+ Conn.exec disable_wire (payto_uri, validity_end)
+
+let get_wire_accounts =
+ let get_wire_accounts =
+ Caqti_type.(unit ->* exchange_wire_account)
+ "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
+ credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
+ wire_accounts WHERE is_active"
+ in
+ fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts ()
+
+let insert_drain_profit =
+ let insert_drain_profit =
+ Caqti_type.(drain_profit_message ->. unit)
+ "INSERT INTO profit_drains (wtid, account_section, payto_uri, \
+ trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v
+
+let insert_aml_officer =
+ let exchange_do_insert_aml_officer =
+ Caqti_type.(aml_officer_setup ->! time)
+ "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \
+ $4, $5, $6)"
+ in
+ fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v
+
+let insert_partner =
+ let insert_partner =
+ Caqti_type.(exchange_partner_setup ->. unit)
+ "INSERT INTO partners (partner_master_pub, start_date, end_date, \
+ wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \
+ $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_partner v
diff --git a/.jjconflict-side-0/src/pg_type.ml b/.jjconflict-side-0/src/pg_type.ml
new file mode 100644
index 00000000..0a2e8f15
--- /dev/null
+++ b/.jjconflict-side-0/src/pg_type.ml
@@ -0,0 +1,377 @@
+(* this module defines caqti encoding/decodings *)
+open Caqti_type
+open Crypto
+open Api
+
+(* TODO
+ check that we use Caqti_type.octets for binary data *)
+
+let amount : Amount.t t =
+ let open Amount in
+ custom
+ ~encode:(fun amount -> Ok (amount.value, amount.fraction))
+ ~decode:(fun (value, fraction) ->
+ Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
+ (t2 int64 int32)
+
+(* we want to use int64 timestamps,
+ not postgresql built-in timestamp type *)
+let ptime : unit t = Caqti_type.unit
+let time = Timestamp.caqti
+let time_span = Time.Relative.caqti
+let age_mask : int t = Caqti_type.int
+let rsa_pub = RsaPublicKey.caqti
+let eddsa_pub = EddsaPublicKey.caqti
+let eddsa_sig = EddsaSignature.caqti
+
+(* todo: enum type for wire_method? *)
+let wire_method = Caqti_type.string
+let payto_uri = Caqti_type.string
+let b32 = B32.caqti
+
+include struct
+ (* alias for hash *)
+ open Hash
+
+ let fullpayto_hash = FullPaytoHash.caqti
+ let nomalizaedpayto_hash = NormalizedPaytoHash.caqti
+ let denomination_hash = DenominationHash.caqti
+ let privatecontract_hash = PrivateContractHash.caqti
+ let extensionspolicy_hash = ExtensionsPolicyHash.caqti
+ let merchantwire_hash = MerchantWireHash.caqti
+ let agecommitment_hash = AgeCommitmentHash.caqti
+ let blindedcoin_hash = BlindedCoinHash.caqti
+ let coinpub_hash = CoinPubHash.caqti
+ let outputcommitment_hash = OutputCommitmentHash.caqti
+ let planchets_hash = HashPlanchetsP.caqti
+end
+
+let signkey_data =
+ let master_sig = Signatures.ExchangeSigningKeyValidity.caqti in
+ let revoked_sig = option Signatures.MasterSigningKeyRevocation.caqti in
+ custom
+ ~encode:(fun
+ Signkey_data.
+ { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
+ ->
+ match master_sig with
+ | None -> Error "signkey_data master_sig is none"
+ | Some master_sig ->
+ Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig))
+ ~decode:(fun
+ (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig) ->
+ Ok
+ {
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig= Some master_sig;
+ revoked_sig;
+ })
+ (t6 eddsa_pub time time time master_sig revoked_sig)
+
+let denom_data =
+ let master_sig = Signatures.DenominationKeyValidity.caqti in
+ let revoked_sig = option Signatures.MasterDenominationKeyRevocation.caqti in
+ custom
+ ~encode:(fun
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig;
+ revoked_sig;
+ }
+ ->
+ match master_sig with
+ | None -> Error "denom_data master_sig is none"
+ | Some master_sig ->
+ Ok
+ ( pub,
+ value,
+ stamp_start,
+ stamp_expire_withdraw,
+ stamp_expire_deposit,
+ stamp_expire_legal,
+ fee_withdraw,
+ fee_deposit,
+ fee_refresh,
+ fee_refund,
+ age_mask,
+ (h_pub, master_sig, revoked_sig) ))
+ ~decode:(fun
+ ( pub,
+ value,
+ stamp_start,
+ stamp_expire_withdraw,
+ stamp_expire_deposit,
+ stamp_expire_legal,
+ fee_withdraw,
+ fee_deposit,
+ fee_refresh,
+ fee_refund,
+ age_mask,
+ (h_pub, master_sig, revoked_sig) )
+ ->
+ Ok
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig= Some master_sig;
+ revoked_sig;
+ })
+ (t12 rsa_pub amount time time time time amount amount amount amount int
+ (t3 denomination_hash master_sig revoked_sig))
+
+let account_restrictions =
+ custom
+ ~encode:(fun l -> Api.encode (Jsont.list AccountRestriction.jsont) l)
+ ~decode:(fun s -> Api.decode (Jsont.list AccountRestriction.jsont) s)
+ string
+
+let global_fee =
+ let master_sig = Signatures.GlobalFees.caqti in
+ custom
+ ~encode:(fun
+ GlobalFees.
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ }
+ ->
+ Ok
+ ( start_date,
+ end_date,
+ history_fee,
+ account_fee,
+ purse_fee,
+ history_expiration,
+ purse_account_limit,
+ purse_timeout,
+ master_sig ))
+ ~decode:(fun
+ ( start_date,
+ end_date,
+ history_fee,
+ account_fee,
+ purse_fee,
+ history_expiration,
+ purse_account_limit,
+ purse_timeout,
+ master_sig )
+ ->
+ Ok
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ })
+ Caqti_type.(
+ t9 time time amount amount amount time_span int32 time_span master_sig)
+
+let aggregate_transfer_fee =
+ let master_sig = Signatures.MasterWireFee.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ AggregateTransferFee.
+ { wire_fee; closing_fee; start_date; end_date; sig_ }
+ -> Ok (wire_fee, closing_fee, start_date, end_date, sig_))
+ ~decode:(fun (wire_fee, closing_fee, start_date, end_date, sig_) ->
+ Ok
+ AggregateTransferFee.
+ { wire_fee; closing_fee; start_date; end_date; sig_ })
+ Caqti_type.(t5 amount amount time time master_sig)
+
+let exchange_wire_account =
+ let master_sig = Signatures.MasterWireDetails.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ ExchangeWireAccount.
+ {
+ payto_uri;
+ conversion_url;
+ debit_restrictions;
+ credit_restrictions;
+ master_sig;
+ bank_label;
+ priority;
+ }
+ ->
+ Ok
+ ( payto_uri,
+ conversion_url,
+ debit_restrictions,
+ credit_restrictions,
+ master_sig,
+ bank_label,
+ priority ))
+ ~decode:(fun
+ ( payto_uri,
+ conversion_url,
+ debit_restrictions,
+ credit_restrictions,
+ master_sig,
+ bank_label,
+ priority )
+ ->
+ Ok
+ {
+ payto_uri;
+ conversion_url;
+ debit_restrictions;
+ credit_restrictions;
+ master_sig;
+ bank_label;
+ priority;
+ })
+ Caqti_type.(
+ t7 payto_uri (option string) account_restrictions account_restrictions
+ master_sig (option string) (option int))
+
+let drain_profit_message =
+ let master_sig = Signatures.MasterDrainProfit.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ DrainProfitsMessage.
+ {
+ wtid;
+ debit_account_section;
+ credit_payto_uri;
+ date;
+ amount;
+ master_sig;
+ }
+ ->
+ Ok
+ (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig))
+ ~decode:(fun
+ (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig)
+ ->
+ Ok
+ {
+ wtid;
+ debit_account_section;
+ credit_payto_uri;
+ date;
+ amount;
+ master_sig;
+ })
+ Caqti_type.(t6 b32 string string time amount master_sig)
+
+let aml_officer_setup =
+ let master_sig = Signatures.MasterAmlOfficerStatus.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ AmlOfficerSetup.
+ {
+ officer_pub;
+ master_sig;
+ officer_name;
+ is_active;
+ read_only;
+ change_date;
+ }
+ ->
+ Ok
+ ( officer_pub,
+ master_sig,
+ officer_name,
+ is_active,
+ read_only,
+ change_date ))
+ ~decode:(fun
+ ( officer_pub,
+ master_sig,
+ officer_name,
+ is_active,
+ read_only,
+ change_date )
+ ->
+ Ok
+ {
+ officer_pub;
+ master_sig;
+ officer_name;
+ is_active;
+ read_only;
+ change_date;
+ })
+ Caqti_type.(t6 eddsa_pub master_sig string bool bool time)
+
+let exchange_partner_setup =
+ let master_sig = Signatures.PartnerConfiguration.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ ExchangePartnerSetupRequest.
+ {
+ partner_pub;
+ start_date;
+ end_date;
+ wad_frequency;
+ wad_fee;
+ master_sig;
+ partner_base_url;
+ }
+ ->
+ Ok
+ ( partner_pub,
+ start_date,
+ end_date,
+ wad_frequency,
+ wad_fee,
+ master_sig,
+ partner_base_url ))
+ ~decode:(fun
+ ( partner_pub,
+ start_date,
+ end_date,
+ wad_frequency,
+ wad_fee,
+ master_sig,
+ partner_base_url )
+ ->
+ Ok
+ {
+ partner_base_url;
+ partner_pub;
+ wad_frequency;
+ master_sig;
+ start_date;
+ end_date;
+ wad_fee;
+ })
+ Caqti_type.(t7 eddsa_pub time time time_span amount master_sig string)
diff --git a/.jjconflict-side-0/src/respond_util.ml b/.jjconflict-side-0/src/respond_util.ml
new file mode 100644
index 00000000..0303c12c
--- /dev/null
+++ b/.jjconflict-side-0/src/respond_util.ml
@@ -0,0 +1,25 @@
+(* TODO response
+ use ErrorDetail *)
+
+let respond_with_plain_text_error ?status e req =
+ let open Vif.Response in
+ let open Syntax in
+ let status = Option.value ~default:`Bad_request status in
+ let* () = add ~field:"content-type" "text/plain; charset=utf-8" in
+ let* () = with_string req e in
+ respond status
+
+let respond_with_ok_json content req =
+ let open Vif.Response in
+ let open Syntax in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string req content in
+ respond `OK
+
+let respond_with_res res req =
+ match res with
+ | Error err ->
+ Logs.err (fun m -> m "%s." err);
+ let err = Fmt.str "%s@." err in
+ respond_with_plain_text_error err req
+ | Ok content -> respond_with_ok_json content req
diff --git a/.jjconflict-side-0/src/secmod.ml b/.jjconflict-side-0/src/secmod.ml
new file mode 100644
index 00000000..528db20d
--- /dev/null
+++ b/.jjconflict-side-0/src/secmod.ml
@@ -0,0 +1,411 @@
+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 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.(Config.secrets_dir / "sk_sm")
+ in
+ let* signkeys =
+ let l =
+ List.init 1 (fun i -> Fpath.(Config.secrets_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.(Config.secrets_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.(Config.secrets_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.(Config.secrets_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.(Config.secrets_dir / section_name) in
+ (fname, key.priv))
+ in
+ list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l
+ in
+ Logs.info (fun m -> m "stored secmod data to file");
+ Ok ()
+end
diff --git a/.jjconflict-side-0/src/secmod.mli b/.jjconflict-side-0/src/secmod.mli
new file mode 100644
index 00000000..0205b866
--- /dev/null
+++ b/.jjconflict-side-0/src/secmod.mli
@@ -0,0 +1,46 @@
+module type S = sig
+ open Crypto
+
+ val sign_with_sm_key : string -> eddsa_sig
+ val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
+ val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
+ val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
+
+ val verify_with_signkey :
+ pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
+
+ (* TODO query database instead? *)
+ val get_sm_key_pub : unit -> eddsa_pub
+ val get_signkeys_data : unit -> Signkey_data.t list
+ val get_denoms_data : unit -> Denom_data.t list
+ val find_signkey_data : eddsa_pub -> Signkey_data.t option
+ val find_denom_data : denomination_hash -> Denom_data.t option
+ val find_denom_section_name : denomination_hash -> string option
+
+ (* - management operations - *)
+ (* TODO
+ problem of keeping db and secmod state syncronized
+ do db interaction from secmod? *)
+
+ val add_signkey_master_signatures :
+ (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list ->
+ (unit, string) result
+
+ val add_denom_master_signatures :
+ (denomination_hash * Signatures.DenominationKeyValidity.t) list ->
+ (unit, string) result
+
+ val revoke_signkey :
+ eddsa_pub ->
+ Signatures.MasterSigningKeyRevocation.t ->
+ (unit, string) result
+
+ val revoke_denomination :
+ denomination_hash ->
+ Signatures.MasterDenominationKeyRevocation.t ->
+ (unit, string) result
+
+ val store : unit -> (unit, string) result
+end
+
+module Make (_ : Pg.CONN) : S
diff --git a/.jjconflict-side-0/src/signatures.ml b/.jjconflict-side-0/src/signatures.ml
new file mode 100644
index 00000000..4855835c
--- /dev/null
+++ b/.jjconflict-side-0/src/signatures.ml
@@ -0,0 +1,1312 @@
+(* TODO debug sig
+ check with taler-wallet-core/src/crypto/cryptoImplementation.js
+ unsigned-ints
+
+ can we skip defining a specific record for signatures and directly use Api records? *)
+open Hash
+
+module Aliases = struct
+ module Timestamp = struct
+ type t = Time.Timestamp.t
+
+ let bin = Time.Timestamp.bin
+ end
+
+ module TimestampNBO = struct
+ type t = Time.Timestamp.t
+
+ let bin = Time.Timestamp.bin_nbo
+ end
+
+ module TimeRelative = struct
+ type t = Time.Relative.t
+
+ let bin = Time.Relative.bin
+ end
+
+ module TimeRelativeNBO = struct
+ type t = Time.Relative.t
+
+ let bin = Time.Relative.bin_nbo
+ end
+
+ module AmountNBO = struct
+ type t = Amount.t
+
+ let bin = Amount.bin_nbo
+ end
+
+ (* - Keys - *)
+
+ (* some of those are actuall ecdhe, or union of eddsa|ecdhe *)
+ open Crypto
+ module PursePublicKey = EddsaPublicKey
+ module AuditorPublicKeyP = EddsaPublicKey
+ module ReservePublicKeyP = EddsaPublicKey
+ module MerchantPublicKeyP = EddsaPublicKey
+ module TransferPublicKeyP = EddsaPublicKey
+ module AmlOfficerPublicKeyP = EddsaPublicKey
+ module ExchangePublicKeyP = EddsaPublicKey
+ module MasterPublicKeyP = EddsaPublicKey
+ module CoinSpendPublicKeyP = EddsaPublicKey
+ module TokenPublicKeyP = EddsaPublicKey
+ module ReservePrivateKeyP = EddsaPrivateKey
+ module MerchantPrivateKeyP = EddsaPrivateKey
+ module TransferPrivateKeyP = EddsaPrivateKey
+ module AmlOfficerPrivateKeyP = EddsaPrivateKey
+ module ExchangePrivateKeyP = EddsaPrivateKey
+ module MasterPrivateKeyP = EddsaPrivateKey
+ module CoinSpendPrivateKeyP = EddsaPrivateKey
+ module MasterSignatureP = EddsaSignature
+ module ReserveSignatureP = EddsaSignature
+ module ExchangeSignatureP = EddsaSignature
+ module CoinSpendSignatureP = EddsaSignature
+end
+
+open Aliases
+
+let int32_size = 4
+let int64_size = 8
+
+module Bytes32 = struct
+ type t = string
+
+ let bin = Bin.bytes 32
+end
+
+module Bytes64 = struct
+ type t = string
+
+ let bin = Bin.bytes 64
+end
+
+module TransferSecretP = Bytes64
+module LinkSecretP = Bytes64
+module EncryptedLinkSecretP = Bytes64
+module BlindingMasterSeed = Bytes32
+module BlindingMasterSecret = Bytes32
+module WireTransferIdentifierRawP = Bytes32
+module PublicRefreshCoinNonceP = Bytes64
+module DenominationBlindingKeyP = Bytes32
+module RefreshCommitmentP = Bytes64
+
+module UUID = struct
+ type t = string
+
+ let size = 4 * int32_size
+ let bin = Bin.bytes size
+end
+
+module WadId = struct
+ type t = string
+
+ let size = 6 * int32_size
+ let bin = Bin.bytes size
+end
+
+module AgeMask = struct
+ type t = int32
+
+ let bin = Bin.beint32
+end
+
+(* --- *)
+
+(* EccSignaturePurpose *)
+module Purpose = struct
+ type t = {
+ size: int32;
+ purpose: int32;
+ }
+
+ let bin =
+ let open Bin in
+ record (fun size purpose -> { size; purpose })
+ |+ field beint32 (fun t -> t.size)
+ |+ field beint32 (fun t -> t.purpose)
+ |> sealr
+
+ let make ~size purpose = { size= Int32.of_int size; purpose }
+ let dummy = make ~size:0 0_l
+
+ (* helper function to make ['signature Bin.t]
+ to compute [t.size], we first build a bin with a dummy purpose *)
+ let make_bin =
+ let get_size f =
+ let open Bin in
+ match Size.of_value (Size.size_of (f dummy)) with
+ | Dynamic _ | Unknown ->
+ Fmt.failwith "size_of failure: size is not Static"
+ | Static n -> n
+ in
+ fun code f -> make ~size:(get_size f) code |> f
+
+ let field purpose = Bin.field bin (fun _t -> purpose)
+end
+
+(* --- Packed Signatures --- *)
+
+module MK (R : sig
+ type r
+
+ val bin : r Bin.t
+end) : sig
+ open Crypto
+
+ type r = R.r
+ type t
+
+ val sign_f : f:(string -> eddsa_sig) -> r -> t
+
+ val verify_f :
+ f:(eddsa_sig -> msg:string -> (unit, string) result) ->
+ t ->
+ r ->
+ (unit, string) result
+
+ val jsont : t Jsont.t
+ val caqti : t Caqti_type.t
+
+ (* TODO rm *)
+ (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *)
+ val to_octets : t -> string
+end = struct
+ open Crypto
+
+ type r = R.r
+ type t = EddsaSignature.t
+
+ let sign_f ~f r = f (Bin.to_string R.bin r)
+ let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin r)
+ let jsont = EddsaSignature.jsont
+ let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti
+ let to_octets t = EddsaSignature.to_octets t
+end
+
+module DenominationKeyAnnouncement = struct
+ module R = struct
+ (* TODO CS: use purpose TALER_SIGNATURE_SM_CS_DENOMINATION_KEY *)
+ (* purpose.purpose = TALER_SIGNATURE_SM_RSA_DENOMINATION_KEY *)
+ type r = {
+ h_denom_pub: DenominationHash.t;
+ h_section_name: Hash.Cstring.H64.t;
+ anchor_time: TimestampNBO.t;
+ duration_withdraw: TimeRelativeNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.sm_rsa_denomination_key
+ @@ fun purpose ->
+ record
+ (fun
+ _purpose h_denom_pub h_section_name anchor_time duration_withdraw ->
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw })
+ |+ Purpose.field purpose
+ |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_section_name)
+ |+ field TimestampNBO.bin (fun t -> t.anchor_time)
+ |+ field TimeRelativeNBO.bin (fun t -> t.duration_withdraw)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module SigningKeyAnnouncement = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_SM_SIGNING_KEY *)
+ type r = {
+ exchange_pub: ExchangePublicKeyP.t;
+ anchor_time: TimestampNBO.t;
+ duration: TimeRelativeNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.sm_signing_key @@ fun purpose ->
+ record (fun _purpose exchange_pub anchor_time duration ->
+ { exchange_pub; anchor_time; duration })
+ |+ Purpose.field purpose
+ |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
+ |+ field TimestampNBO.bin (fun t -> t.anchor_time)
+ |+ field TimeRelativeNBO.bin (fun t -> t.duration)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module DenominationKeyValidity = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_VALIDITY *)
+ type r = {
+ master: MasterPublicKeyP.t;
+ start: TimestampNBO.t;
+ expire_withdraw: TimestampNBO.t;
+ expire_spend: TimestampNBO.t;
+ expire_legal: TimestampNBO.t;
+ value: AmountNBO.t;
+ fee_withdraw: AmountNBO.t;
+ fee_deposit: AmountNBO.t;
+ fee_refresh: AmountNBO.t;
+ (* TODO debug sig
+ missing field from taler doc *)
+ fee_refund: AmountNBO.t;
+ denom_hash: DenominationHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_denomination_key_validity
+ @@ fun purpose ->
+ record
+ (fun
+ _purpose
+ master
+ start
+ expire_withdraw
+ expire_spend
+ expire_legal
+ value
+ fee_withdraw
+ fee_deposit
+ fee_refresh
+ fee_refund
+ denom_hash
+ ->
+ {
+ master;
+ start;
+ expire_withdraw;
+ expire_spend;
+ expire_legal;
+ value;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_hash;
+ })
+ |+ Purpose.field purpose
+ |+ field MasterPublicKeyP.bin (fun t -> t.master)
+ |+ field TimestampNBO.bin (fun t -> t.start)
+ |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
+ |+ field TimestampNBO.bin (fun t -> t.expire_spend)
+ |+ field TimestampNBO.bin (fun t -> t.expire_legal)
+ |+ field AmountNBO.bin (fun t -> t.value)
+ |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
+ |+ field AmountNBO.bin (fun t -> t.fee_deposit)
+ |+ field AmountNBO.bin (fun t -> t.fee_refresh)
+ |+ field AmountNBO.bin (fun t -> t.fee_refund)
+ |+ field DenominationHash.bin (fun t -> t.denom_hash)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module ExchangeSigningKeyValidity = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_VALIDITY *)
+ type r = {
+ start: TimestampNBO.t;
+ expire: TimestampNBO.t;
+ end_: TimestampNBO.t;
+ signkey_pub: ExchangePublicKeyP.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_signing_key_validity
+ @@ fun purpose ->
+ record (fun _purpose start expire end_ signkey_pub ->
+ { start; expire; end_; signkey_pub })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.start)
+ |+ field TimestampNBO.bin (fun t -> t.expire)
+ |+ field TimestampNBO.bin (fun t -> t.end_)
+ |+ field ExchangePublicKeyP.bin (fun t -> t.signkey_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDenominationKeyRevocation = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_REVOKED. *)
+ type r = { h_denom_pub: DenominationHash.t }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_denomination_key_revoked
+ @@ fun purpose ->
+ record (fun _purpose h_denom_pub -> { h_denom_pub })
+ |+ Purpose.field purpose
+ |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterSigningKeyRevocation = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_REVOKED *)
+ type r = { exchange_pub: ExchangePublicKeyP.t }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_signing_key_revoked
+ @@ fun purpose ->
+ record (fun _purpose exchange_pub -> { exchange_pub })
+ |+ Purpose.field purpose
+ |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterAddAuditor = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_AUDITOR *)
+ type r = {
+ start_date: TimestampNBO.t;
+ auditor_pub: AuditorPublicKeyP.t;
+ h_auditor_url: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_add_auditor @@ fun purpose ->
+ record (fun _purpose start_date auditor_pub h_auditor_url ->
+ { start_date; auditor_pub; h_auditor_url })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_auditor_url)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDelAuditor = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_AUDITOR *)
+ type r = {
+ end_date: TimestampNBO.t;
+ auditor_pub: AuditorPublicKeyP.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_del_auditor @@ fun purpose ->
+ record (fun _purpose end_date auditor_pub -> { end_date; auditor_pub })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module GlobalFees = struct
+ module R = struct
+ (* TODO debug sig
+ taler doc *)
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *)
+ type r = {
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ purse_timeout: TimeRelativeNBO.t;
+ history_expiration: TimeRelativeNBO.t;
+ history_fee: AmountNBO.t;
+ account_fee: AmountNBO.t;
+ purse_fee: AmountNBO.t;
+ purse_account_limit: int32;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_global_fees @@ fun purpose ->
+ record
+ (fun
+ _purpose
+ start_date
+ end_date
+ purse_timeout
+ history_expiration
+ history_fee
+ account_fee
+ purse_fee
+ purse_account_limit
+ ->
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field TimeRelativeNBO.bin (fun t -> t.purse_timeout)
+ |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration)
+ |+ field AmountNBO.bin (fun t -> t.history_fee)
+ |+ field AmountNBO.bin (fun t -> t.account_fee)
+ |+ field AmountNBO.bin (fun t -> t.purse_fee)
+ |+ field beint32 (fun t -> t.purse_account_limit)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterWireDetails = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_DETAILS *)
+ type r = {
+ h_wire_details: FullPaytoHash.t;
+ h_conversion_url: Hash.Cstring.H64.t;
+ h_credit_restrictions: Hash.Cstring.H64.t;
+ h_debit_restrictions: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_wire_details @@ fun purpose ->
+ record
+ (fun
+ _purpose
+ h_wire_details
+ h_conversion_url
+ h_credit_restrictions
+ h_debit_restrictions
+ ->
+ {
+ h_wire_details;
+ h_conversion_url;
+ h_credit_restrictions;
+ h_debit_restrictions;
+ })
+ |+ Purpose.field purpose
+ |+ field FullPaytoHash.bin (fun t -> t.h_wire_details)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterAddWire = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_WIRE *)
+ type r = {
+ start_date: TimestampNBO.t;
+ h_wire: FullPaytoHash.t;
+ h_conversion_url: Hash.Cstring.H64.t;
+ h_credit_restrictions: Hash.Cstring.H64.t;
+ h_debit_restrictions: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_add_wire @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ start_date
+ h_wire
+ h_conversion_url
+ h_credit_restrictions
+ h_debit_restrictions
+ ->
+ {
+ start_date;
+ h_wire;
+ h_conversion_url;
+ h_credit_restrictions;
+ h_debit_restrictions;
+ })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field FullPaytoHash.bin (fun t -> t.h_wire)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDelWire = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_WIRE *)
+ type r = {
+ end_date: TimestampNBO.t;
+ h_wire: FullPaytoHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_del_wire @@ fun _purpose ->
+ record (fun _purpose end_date h_wire -> { end_date; h_wire })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field FullPaytoHash.bin (fun t -> t.h_wire)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDrainProfit = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DRAIN_PROFITS *)
+ type r = {
+ wtid: WireTransferIdentifierRawP.t;
+ date: TimestampNBO.t;
+ amount: AmountNBO.t;
+ h_section: Hash.Cstring.H64.t;
+ h_payto: FullPaytoHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_drain_profit @@ fun _purpose ->
+ record (fun _purpose wtid date amount h_section h_payto ->
+ { wtid; date; amount; h_section; h_payto })
+ |+ Purpose.field _purpose
+ |+ field WireTransferIdentifierRawP.bin (fun t -> t.wtid)
+ |+ field TimestampNBO.bin (fun t -> t.date)
+ |+ field AmountNBO.bin (fun t -> t.amount)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_section)
+ |+ field FullPaytoHash.bin (fun t -> t.h_payto)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterAmlOfficerStatus = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_AML_KEY *)
+ type r = {
+ change_date: TimestampNBO.t;
+ officer_pub: AmlOfficerPublicKeyP.t;
+ h_officer_name: Hash.Cstring.H64.t;
+ is_active: int32;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_aml_key @@ fun _purpose ->
+ record (fun _purpose change_date officer_pub h_officer_name is_active ->
+ { change_date; officer_pub; h_officer_name; is_active })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.change_date)
+ |+ field AmlOfficerPublicKeyP.bin (fun t -> t.officer_pub)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_officer_name)
+ |+ field beint32 (fun t -> t.is_active)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module PartnerConfiguration = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_PARNTER_DETAILS *)
+ type r = {
+ partner_pub: MasterPublicKeyP.t;
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ wad_frequency: TimeRelativeNBO.t;
+ wad_fee: AmountNBO.t;
+ h_url: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_partner_details
+ @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ partner_pub
+ start_date
+ end_date
+ wad_frequency
+ wad_fee
+ h_url
+ -> { partner_pub; start_date; end_date; wad_frequency; wad_fee; h_url })
+ |+ Purpose.field _purpose
+ |+ field MasterPublicKeyP.bin (fun t -> t.partner_pub)
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
+ |+ field AmountNBO.bin (fun t -> t.wad_fee)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_url)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module WadPartnerSignature = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_PARTNER_DETAILS *)
+ type r = {
+ h_partner_base_url: Hash.Cstring.H64.t;
+ master_public_key: MasterPublicKeyP.t;
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ wad_fee: AmountNBO.t;
+ wad_frequency: TimeRelativeNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_partner_details
+ @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ h_partner_base_url
+ master_public_key
+ start_date
+ end_date
+ wad_fee
+ wad_frequency
+ ->
+ {
+ h_partner_base_url;
+ master_public_key;
+ start_date;
+ end_date;
+ wad_fee;
+ wad_frequency;
+ })
+ |+ Purpose.field _purpose
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_partner_base_url)
+ |+ field MasterPublicKeyP.bin (fun t -> t.master_public_key)
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field AmountNBO.bin (fun t -> t.wad_fee)
+ |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterWireFee = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_FEES *)
+ type r = {
+ h_wire_method: Hash.Cstring.H64.t;
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ wire_fee: AmountNBO.t;
+ closing_fee: AmountNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_wire_fees @@ fun _purpose ->
+ record
+ (fun _purpose h_wire_method start_date end_date wire_fee closing_fee ->
+ { h_wire_method; start_date; end_date; wire_fee; closing_fee })
+ |+ Purpose.field _purpose
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_wire_method)
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field AmountNBO.bin (fun t -> t.wire_fee)
+ |+ field AmountNBO.bin (fun t -> t.closing_fee)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module ExchangeKeyValidity = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_AUDITOR_EXCHANGE_KEYS *)
+ type r = {
+ auditor_url_hash: Hash.Cstring.H64.t;
+ master: MasterPublicKeyP.t;
+ start: TimestampNBO.t;
+ expire_withdraw: TimestampNBO.t;
+ expire_spend: TimestampNBO.t;
+ expire_legal: TimestampNBO.t;
+ value: AmountNBO.t;
+ fee_withdraw: AmountNBO.t;
+ fee_deposit: AmountNBO.t;
+ fee_refresh: AmountNBO.t;
+ denom_hash: DenominationHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.auditor_exchange_keys @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ auditor_url_hash
+ master
+ start
+ expire_withdraw
+ expire_spend
+ expire_legal
+ value
+ fee_withdraw
+ fee_deposit
+ fee_refresh
+ denom_hash
+ ->
+ {
+ auditor_url_hash;
+ master;
+ start;
+ expire_withdraw;
+ expire_spend;
+ expire_legal;
+ value;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ denom_hash;
+ })
+ |+ Purpose.field _purpose
+ |+ field Hash.Cstring.H64.bin (fun t -> t.auditor_url_hash)
+ |+ field MasterPublicKeyP.bin (fun t -> t.master)
+ |+ field TimestampNBO.bin (fun t -> t.start)
+ |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
+ |+ field TimestampNBO.bin (fun t -> t.expire_spend)
+ |+ field TimestampNBO.bin (fun t -> t.expire_legal)
+ |+ field AmountNBO.bin (fun t -> t.value)
+ |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
+ |+ field AmountNBO.bin (fun t -> t.fee_deposit)
+ |+ field AmountNBO.bin (fun t -> t.fee_refresh)
+ |+ field DenominationHash.bin (fun t -> t.denom_hash)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module ExchangeKeySet = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_KEY_SET *)
+ type r = {
+ list_issue_date: TimestampNBO.t;
+ (* hash over a concatenation of master_sigs *)
+ hc: H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.exchange_key_set @@ fun _purpose ->
+ record (fun _purpose list_issue_date hc -> { list_issue_date; hc })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.list_issue_date)
+ |+ field H64.bin (fun t -> t.hc)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+(* ### BIN IMPL END ### *)
+
+module WithdrawRequest = struct
+ (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
+ type t = {
+ amount: Amount.t;
+ fee: Amount.t;
+ h_planchets: HashPlanchetsP.t;
+ blinding_seed: BlindingMasterSecret.t;
+ max_age_group: int32;
+ mask: AgeMask.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.wallet_reserve_withdraw @@ fun purpose ->
+ record
+ (fun _purpose amount fee h_planchets blinding_seed max_age_group mask ->
+ { amount; fee; h_planchets; blinding_seed; max_age_group; mask })
+ |+ Purpose.field purpose
+ |+ field Amount.bin (fun t -> t.amount)
+ |+ field Amount.bin (fun t -> t.fee)
+ |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
+ |+ field BlindingMasterSecret.bin (fun t -> t.blinding_seed)
+ |+ field beint32 (fun t -> t.max_age_group)
+ |+ field AgeMask.bin (fun t -> t.mask)
+ |> sealr
+end
+
+module WithdrawConfirmation = struct
+ (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW *)
+ type t = {
+ h_planchets: HashPlanchetsP.t;
+ noreveal_index: int32;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.exchange_confirm_withdraw
+ @@ fun purpose ->
+ record (fun _purpose h_planchets noreveal_index ->
+ { h_planchets; noreveal_index })
+ |+ Purpose.field purpose
+ |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
+ |+ field beint32 (fun t -> t.noreveal_index)
+ |> sealr
+end
+
+module SingleWithdrawRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
+ type t = {
+ amount_with_fee: AmountNBO.t;
+ h_denomination_pub: DenominationHash.t;
+ h_coin_envelope: BlindedCoinHash.t;
+ }
+end
+
+module DepositRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_DEPOSIT *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_age_commitment: AgeCommitmentHash.t;
+ h_policy: ExtensionsPolicyHash.t;
+ h_wire: MerchantWireHash.t;
+ h_denom_pub: DenominationHash.t;
+ timestamp: TimestampNBO.t;
+ refund_deadline: TimestampNBO.t;
+ amount_with_fee: AmountNBO.t;
+ deposit_fee: AmountNBO.t;
+ merchant: MerchantPublicKeyP.t;
+ wallet_data_hash: Hash.Cstring.H64.t;
+ }
+end
+
+module DepositConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_DEPOSIT *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: MerchantWireHash.t;
+ h_policy: ExtensionsPolicyHash.t;
+ timestamp: TimestampNBO.t;
+ refund_deadline: TimestampNBO.t;
+ amount_without_fee: AmountNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ merchant: MerchantPublicKeyP.t;
+ }
+end
+
+module RefreshMeltCoinAffirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_MELT *)
+ type t = {
+ session_hash: RefreshCommitmentP.t;
+ h_denom_pub: DenominationHash.t;
+ h_age_commitment: AgeCommitmentHash.t;
+ amount_with_fee: AmountNBO.t;
+ melt_fee: AmountNBO.t;
+ }
+end
+
+module RefreshMeltConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_MELT *)
+ type t = {
+ session_hash: RefreshCommitmentP.t;
+ noreveal_index: int; (* uint16_t mapped to OCaml int *)
+ }
+end
+
+module DepositTrack = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: MerchantWireHash.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ }
+end
+
+module WireDepositDetailP = struct
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ execution_time: TimestampNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ deposit_value: AmountNBO.t;
+ deposit_fee: AmountNBO.t;
+ }
+end
+
+module WireDepositData = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE_DEPOSIT *)
+ type t = {
+ total: AmountNBO.t;
+ wire_fee: AmountNBO.t;
+ merchant_pub: MerchantPublicKeyP.t;
+ h_wire: MerchantWireHash.t;
+ h_details: Hash.Cstring.H64.t;
+ }
+end
+
+module PaymentResponse = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_PAYMENT_OK *)
+ type t = { h_contract_terms: PrivateContractHash.t }
+end
+
+module Contract = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_CONTRACT *)
+ type t = { h_contract_terms: PrivateContractHash.t }
+end
+
+module ConfirmWire = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE *)
+ type t = {
+ h_wire: MerchantWireHash.t;
+ h_contract_terms: PrivateContractHash.t;
+ wtid: WireTransferIdentifierRawP.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ execution_time: TimestampNBO.t;
+ coin_contribution: AmountNBO.t;
+ }
+end
+
+module RefundConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_REFUND *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ merchant: MerchantPublicKeyP.t;
+ rtransaction_id: int64;
+ refund_amount: AmountNBO.t;
+ }
+end
+
+module DepositTrackPS2 = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: MerchantWireHash.t;
+ merchant: MerchantPublicKeyP.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ }
+end
+
+module RefundRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ rtransaction_id: int64;
+ refund_amount: AmountNBO.t;
+ refund_fee: AmountNBO.t;
+ }
+end
+
+module MerchantRefundConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND_OK *)
+ (* Hash of the order ID (a string), hashed without the 0-termination. *)
+ type t = { h_order_id: Hash.Cstring.H64.t }
+end
+
+module RecoupRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_RECOUP or TALER_SIGNATURE_WALLET_COIN_RECOUP_REFRESH *)
+ type t = {
+ h_denom_pub: DenominationHash.t;
+ coin_blind: DenominationBlindingKeyP.t;
+ }
+end
+
+module RecoupRefreshConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP_REFRESH *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ recoup_amount: AmountNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ old_coin_pub: CoinSpendPublicKeyP.t;
+ }
+end
+
+module RecoupConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ recoup_amount: AmountNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ reserve_pub: ReservePublicKeyP.t;
+ }
+end
+
+module DenominationUnknownAffirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_AFFIRM_DENOM_UNKNOWN *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ h_denom_pub: DenominationHash.t;
+ }
+end
+
+module DenominationExpiredAffirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_GENERIC_DENOMINATIN_EXPIRED *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ operation: string; (* char[8] → string *)
+ h_denom_pub: DenominationHash.t;
+ }
+end
+
+module ReserveCloseConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_CLOSED *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ closing_amount: AmountNBO.t;
+ reserve_pub: ReservePublicKeyP.t;
+ h_wire: FullPaytoHash.t;
+ }
+end
+
+module CoinLinkSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
+ type t = {
+ h_denom_pub: DenominationHash.t;
+ old_coin_pub: CoinSpendPublicKeyP.t;
+ transfer_pub: TransferPublicKeyP.t;
+ coin_envelope_hash: BlindedCoinHash.t;
+ }
+end
+
+module RefreshNonceSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
+ type t = { nonce: PublicRefreshCoinNonceP.t }
+end
+
+module ReserveStatusRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_RESERVE_STATUS_REQUEST *)
+ type t = { request_timestamp: TimestampNBO.t }
+end
+
+module ReserveHistoryRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_RESERVE_HISTORY_REQUEST *)
+ type t = {
+ history_fee: AmountNBO.t;
+ request_timestamp: TimestampNBO.t;
+ }
+end
+
+module PurseStatusRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_REQUEST *)
+ type t = unit
+end
+
+module PurseStatusResponseSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_RESPONSE *)
+ type t = {
+ total_purse_amount: AmountNBO.t;
+ total_deposit_amount: AmountNBO.t;
+ max_deposit_fees: AmountNBO.t;
+ purse_expiration: TimestampNBO.t;
+ status_timestamp: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ }
+end
+
+module ReserveCloseRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
+ type t = unit
+end
+
+module PurseRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_CREATE *)
+ type t = {
+ purse_expiration: TimestampNBO.t;
+ merge_value_after_fees: AmountNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ min_age: int;
+ }
+end
+
+module PurseDepositSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT *)
+ type t = {
+ coin_contribution: AmountNBO.t;
+ h_denom_pub: DenominationHash.t;
+ h_age_commitment: AgeCommitmentHash.t;
+ purse_pub: PursePublicKey.t;
+ h_exchange_base_url: Hash.Cstring.H64.t;
+ }
+end
+
+module PurseDepositSignaturePS2 = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN_DEPOSIT *)
+ type t = {
+ reserve_sig: ReserveSignatureP.t;
+ coin_contribution: AmountNBO.t;
+ }
+end
+
+module PurseDepositConfirmedSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT_CONFIRMED *)
+ type t = {
+ total_purse_amount: AmountNBO.t;
+ total_deposit_fees: AmountNBO.t;
+ purse_pub: PursePublicKey.t;
+ purse_expiration: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ }
+end
+
+module PurseMergeSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_MERGE *)
+ type t = {
+ merge_timestamp: TimestampNBO.t;
+ h_wire: NormalizedPaytoHash.t;
+ }
+end
+
+module AccountMergeSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_MERGE *)
+ type t = {
+ reserve_pub: ReservePublicKeyP.t;
+ purse_pub: PursePublicKey.t;
+ merge_amount_after_fees: AmountNBO.t;
+ merge_timestamp: TimestampNBO.t;
+ purse_expiration: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ min_age: int;
+ }
+end
+
+module AccountSetupRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_SETUP *)
+ type t = { threshold: AmountNBO.t }
+end
+
+module PurseMergeSuccessSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_MERGE_SUCCESS *)
+ type t = {
+ reserve_pub: ReservePublicKeyP.t;
+ purse_pub: PursePublicKey.t;
+ merge_amount_after_fees: AmountNBO.t;
+ contract_time: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: NormalizedPaytoHash.t;
+ min_age: int;
+ }
+end
+
+module WadDataSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WAD_DATA *)
+ type t = {
+ wad_execution_time: TimestampNBO.t;
+ total_amount: AmountNBO.t;
+ h_items: Hash.Cstring.H64.t;
+ wad_id: WadId.t;
+ }
+end
+
+module P2PFees = struct
+ (* purpose.purpose = TALER_SIGNATURE_P2P_FEES *)
+ type t = {
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ kyc_fee: AmountNBO.t;
+ purse_fee: AmountNBO.t;
+ account_history_fee: AmountNBO.t;
+ account_annual_fee: AmountNBO.t;
+ account_kyc_timeout: TimeRelativeNBO.t;
+ purse_timeout: TimeRelativeNBO.t;
+ purse_account_limit: int;
+ }
+end
+
+module CoinPurseRefundConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_PURSE_REFUND *)
+ type t = {
+ purse_pub: PursePublicKey.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ refunded_amount: AmountNBO.t;
+ refund_fee: AmountNBO.t;
+ }
+end
+
+module AmlDecision = struct
+ (* purpose.purpose = TALER_SIGNATURE_AML_DECISION *)
+ type t = {
+ h_justification: Hash.Cstring.H64.t;
+ decision_time: TimestampNBO.t;
+ new_threshold: AmountNBO.t;
+ h_payto: NormalizedPaytoHash.t;
+ h_kyc_requirements: Hash.Cstring.H64.t;
+ new_state: int;
+ }
+end
+
+module ReserveOpen = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN *)
+ type t = {
+ reserve_payment: AmountNBO.t;
+ request_timestamp: TimestampNBO.t;
+ reserve_expiration: TimestampNBO.t;
+ purse_limit: int;
+ }
+end
+
+module ReserveClose = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
+ type t = {
+ request_timestamp: TimestampNBO.t;
+ target_account_h_payto: FullPaytoHash.t;
+ }
+end
+
+module ReserveAttestRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_ATTEST_REQUEST *)
+ type t = {
+ request_timestamp: TimestampNBO.t;
+ h_details: Hash.Cstring.H64.t;
+ }
+end
+
+module ExchangeAttest = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_ATTEST_DETAILS *)
+ type t = {
+ attest_timestamp: TimestampNBO.t;
+ expiration_time: TimestampNBO.t;
+ reserve_pub: ReservePublicKeyP.t;
+ h_attributes: Hash.Cstring.H64.t;
+ }
+end
diff --git a/.jjconflict-side-0/src/signkey_data.ml b/.jjconflict-side-0/src/signkey_data.ml
new file mode 100644
index 00000000..22a7a0cd
--- /dev/null
+++ b/.jjconflict-side-0/src/signkey_data.ml
@@ -0,0 +1,10 @@
+open Crypto
+
+type t = {
+ pub: eddsa_pub;
+ stamp_start: Timestamp.t;
+ stamp_expire: Timestamp.t;
+ stamp_end: Timestamp.t;
+ master_sig: Signatures.ExchangeSigningKeyValidity.t option;
+ revoked_sig: Signatures.MasterSigningKeyRevocation.t option;
+}
diff --git a/src/static.ml b/.jjconflict-side-0/src/static.ml
similarity index 100%
rename from src/static.ml
rename to .jjconflict-side-0/src/static.ml
diff --git a/.jjconflict-side-0/src/syntax.ml b/.jjconflict-side-0/src/syntax.ml
new file mode 100644
index 00000000..c61aba15
--- /dev/null
+++ b/.jjconflict-side-0/src/syntax.ml
@@ -0,0 +1,51 @@
+let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
+let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e
+
+(* TODO use polymorphic variant for errors *)
+let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
+
+let unwrap_err_caqti o =
+ match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
+
+let list_iter f l =
+ let err = ref None in
+ try
+ List.iter
+ (fun v ->
+ match f v with
+ | Error _e as e ->
+ err := Some e;
+ raise Exit
+ | Ok () -> ())
+ l;
+ Ok ()
+ with Exit -> ( match !err with None -> assert false | Some v -> v)
+
+let list_map f l =
+ let err = ref None in
+ try
+ Ok
+ (List.map
+ (fun v ->
+ match f v with
+ | Error _e as e ->
+ err := Some e;
+ raise Exit
+ | Ok v -> v)
+ l)
+ with Exit -> ( match !err with None -> assert false | Some v -> v)
+
+let list_fold_left f acc l =
+ List.fold_left
+ (fun acc v ->
+ let* acc = acc in
+ f acc v)
+ (Ok acc) l
+
+let opt_list l =
+ match (List.for_all Option.is_none l, List.for_all Option.is_some l) with
+ | _, true ->
+ let l = List.map Option.get l in
+ Ok (Some l)
+ | true, _ -> Ok None
+ | _, _ -> Error ()
diff --git a/.jjconflict-side-0/src/taler_signatures.ml b/.jjconflict-side-0/src/taler_signatures.ml
new file mode 100644
index 00000000..8715b472
--- /dev/null
+++ b/.jjconflict-side-0/src/taler_signatures.ml
@@ -0,0 +1,280 @@
+(* This file was generated from the GANA database:
+ https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)
+
+(** Initialize or update the status of an AML key for an AML officer *)
+let master_aml_key : int32 = 1017_l
+
+(** Affirm wiring of exchange profits to operator account. *)
+let master_drain_profit : int32 = 1018_l
+
+(** Signature affirming a partner configuration for wads. *)
+let master_partner_details : int32 = 1019_l
+
+(** The given revocation key was revoked and must no longer be used. *)
+let master_signing_key_revoked : int32 = 1020_l
+
+(** Add payto URI to the list of our wire methods. *)
+let master_add_wire : int32 = 1021_l
+
+(** Signature over global set of fees charged by the exchange. *)
+let master_global_fees : int32 = 1022_l
+
+(** Remove payto URI from the list of our wire methods. *)
+let master_del_wire : int32 = 1023_l
+
+(** Purpose for signing public keys signed by the exchange master key. *)
+let master_signing_key_validity : int32 = 1024_l
+
+(** Purpose for denomination keys signed by the exchange master key. *)
+let master_denomination_key_validity : int32 = 1025_l
+
+(** Add an auditor to the list of our auditors. *)
+let master_add_auditor : int32 = 1026_l
+
+(** Remove an auditor from the list of our auditors. *)
+let master_del_auditor : int32 = 1027_l
+
+(** Fees charged per (aggregate) wire transfer to the merchant. *)
+let master_wire_fees : int32 = 1028_l
+
+(** The given revocation key was revoked and must no longer be used. *)
+let master_denomination_key_revoked : int32 = 1029_l
+
+(** Signature where the Exchange confirms its IBAN details in the /wire
+ response. *)
+let master_wire_details : int32 = 1030_l
+
+(** Set the configuration of an extension (age-restriction or peer2peer) *)
+let master_extension : int32 = 1031_l
+
+(** Purpose for the state of a reserve, signed by the exchange's signing key. *)
+let exchange_reserve_status : int32 = 1032_l
+
+(** Signature where the Exchange confirms a deposit request. *)
+let exchange_confirm_deposit : int32 = 1033_l
+
+(** Signature where the exchange (current signing key) confirms the no-reveal
+ index for cut-and-choose and the validity of the melted coins. *)
+let exchange_confirm_melt : int32 = 1034_l
+
+(** Signature where the Exchange confirms the full /keys response set. *)
+let exchange_key_set : int32 = 1035_l
+
+(** Signature where the Exchange confirms the /track/transaction response. *)
+let exchange_confirm_wire : int32 = 1036_l
+
+(** Signature where the Exchange confirms the /wire/deposit response. *)
+let exchange_confirm_wire_deposit : int32 = 1037_l
+
+(** Signature where the Exchange confirms a refund request. *)
+let exchange_confirm_refund : int32 = 1038_l
+
+(** Signature where the Exchange confirms a recoup. *)
+let exchange_confirm_recoup : int32 = 1039_l
+
+(** Signature where the Exchange confirms it closed a reserve. *)
+let exchange_reserve_closed : int32 = 1040_l
+
+(** Signature where the Exchange confirms a recoup-refresh operation. *)
+let exchange_confirm_recoup_refresh : int32 = 1041_l
+
+(** Signature where the Exchange confirms that it does not know a denomination
+ (hash). *)
+let exchange_affirm_denom_unknown : int32 = 1042_l
+
+(** Signature where the Exchange confirms that it does not consider a
+ denomination valid for the given operation at this time. *)
+let exchange_affirm_denom_expired : int32 = 1043_l
+
+(** Signature by which the exchange affirms that a purse was created with a
+ certain amount deposited into it. *)
+let exchange_confirm_purse_creation : int32 = 1045_l
+
+(** Signature by which the exchange affirms that a purse was merged into a
+ reserve with a certain amount in it. *)
+let exchange_confirm_purse_merged : int32 = 1046_l
+
+(** Purpose for the state of a purse, signed by the exchange's signing key. *)
+let exchange_purse_status : int32 = 1047_l
+
+(** Signature by which the exchange attests identity attributes of a particular
+ reserve owner. *)
+let exchange_reserve_attest_details : int32 = 1048_l
+
+(** Signature by which the exchange confirms that a purse expired and a coin was
+ refunded. *)
+let exchange_confirm_purse_refund : int32 = 1049_l
+
+(** Signature where the Exchange confirms an (age-)withdraw. *)
+let exchange_confirm_withdraw : int32 = 1050_l
+
+(** Signature where the auditor confirms that he is aware of certain
+ denomination keys from the exchange. *)
+let auditor_exchange_keys : int32 = 1064_l
+
+(** Signature where the merchant confirms a contract (to the customer). *)
+let merchant_contract : int32 = 1101_l
+
+(** Signature where the merchant confirms a refund (of a coin). *)
+let merchant_refund : int32 = 1102_l
+
+(** Signature where the merchant confirms that he needs the wire transfer
+ identifier for a deposit operation. *)
+let merchant_track_transaction : int32 = 1103_l
+
+(** Signature where the merchant confirms that the payment was successful *)
+let merchant_payment_ok : int32 = 1104_l
+
+(** Signature where the merchant confirms its own (salted) wire details (not yet
+ really used). *)
+let merchant_wire_details : int32 = 1107_l
+
+(** Signature where the merchant issues a token by blindly signing it. Signed
+ with the token issue private key. *)
+let merchant_token_issue : int32 = 1108_l
+
+(** Signature where the reserve key confirms a withdraw request. Signed with the
+ reserve private key. *)
+let wallet_reserve_withdraw : int32 = 1200_l
+
+(** Signature made by the wallet of a user to confirm a deposit of a coin. *)
+let wallet_coin_deposit : int32 = 1201_l
+
+(** Signature using a coin key confirming the melting of a coin. Signed with the
+ coin's private key. *)
+let wallet_coin_melt : int32 = 1202_l
+
+(** Signature using a coin key requesting recoup. Signed with the coin's private
+ key. *)
+let wallet_coin_recoup : int32 = 1203_l
+
+(** Signature using a coin key authenticating link data. Signed with the old
+ coin's private key. *)
+let wallet_coin_link : int32 = 1204_l
+
+(** Signature using a reserve key by which a wallet requests a payment target
+ UUID for itself. Signs over just a purpose (no body), as the signature only
+ serves to demonstrate that the request comes from the wallet controlling the
+ private key, and not some third party. *)
+let wallet_account_setup : int32 = 1205_l
+
+(** Signature using a coin key requesting recoup-refresh. Signed with the coin
+ private key. *)
+let wallet_coin_recoup_refresh : int32 = 1206_l
+
+(** Signature using a age restriction key for attestation of a particular
+ age/age-group. *)
+let wallet_age_attestation : int32 = 1207_l
+
+(** Request full or partial reserve history. Signed with the reserve private
+ key. *)
+let wallet_reserve_history : int32 = 1208_l
+
+(** Request full or partial coin history. Signed with the coin private key. *)
+let wallet_coin_history : int32 = 1209_l
+
+(** Request purse creation (without reserve). Signed by the purse private key.
+*)
+let wallet_purse_create : int32 = 1210_l
+
+(** Request coin to be deposited into a purse. Signed with the coin private key.
+*)
+let wallet_purse_deposit : int32 = 1211_l
+
+(** Request purse status. Signed with the purse private key. *)
+let wallet_purse_status : int32 = 1212_l
+
+(** Request purse to be merged with a reserve. Signed with the purse private
+ key. *)
+let wallet_purse_merge : int32 = 1213_l
+
+(** Request purse to be merged with a reserve. Signed by the reserve private
+ key. *)
+let wallet_account_merge : int32 = 1214_l
+
+(** Request account to be closed. Signed with the reserve private key. *)
+let wallet_reserve_close : int32 = 1215_l
+
+(** Associates encrypted contract with a purse. Signed with the purse private
+ key. *)
+let wallet_purse_econtract : int32 = 1216_l
+
+(** Request reserve to be kept open. Signed with the reserve private key. *)
+let wallet_reserve_open : int32 = 1217_l
+
+(** Request coin to be used to pay for reserve to be kept open. Signed with the
+ coin private key. *)
+let wallet_reserve_open_deposit : int32 = 1218_l
+
+(** Request attestation about reserve owner. Signed by the reserve private key.
+*)
+let wallet_reserve_attest_details : int32 = 1219_l
+
+(** Signature by which a wallet requests a purse to be deleted. *)
+let wallet_purse_delete : int32 = 1220_l
+
+(** Signature where the reserve key confirms an age-withdraw request. Signed
+ with the reserve private key. *)
+let wallet_reserve_age_withdraw : int32 = 1221_l
+
+(** Signature where the token use key confirms the usage of a token on a pay
+ request. Signed with the token use private key. *)
+let wallet_token_use : int32 = 1222_l
+
+(** Signature used to unclaim an order, allowing other wallets to claim it.
+ Signed with the private key of the claim nonce. *)
+let wallet_order_unclaim : int32 = 1223_l
+
+(** Signature on a denomination key announcement. *)
+let sm_rsa_denomination_key : int32 = 1250_l
+
+(** Signature on an exchange message signing key announcement. *)
+let sm_signing_key : int32 = 1251_l
+
+(** Signature on a denomination key announcement. *)
+let sm_cs_denomination_key : int32 = 1252_l
+
+(** EdDSA test signature. *)
+let client_test_eddsa : int32 = 1302_l
+
+(** EdDSA test signature. *)
+let exchange_test_eddsa : int32 = 1303_l
+
+(** Signature by which an AML officer signs an AML decision. *)
+let aml_decision : int32 = 1350_l
+
+(** Signature by which an AML officer requests AML data. *)
+let aml_query : int32 = 1351_l
+
+(** Signature by which an account owner authorizes access to a KYC operation. *)
+let kyc_auth : int32 = 1360_l
+
+(** EdDSA signature for a policy upload. *)
+let anastasis_policy_upload : int32 = 1400_l
+
+(** EdDSA signature for a backup upload. *)
+let sync_backup_upload : int32 = 1450_l
+
+(** The signature is done by the Donau. The Donau signes over the total amount
+ of the corresponding year, the corresponding year and the donation
+ identifier of a specific donor. The statement confirms that the donor made
+ this total in donations for the given year. *)
+let donau_donation_statement : int32 = 1500_l
+
+(** The signature is made by a charity and shows that the charity is in
+ agreement with the donation request which it sends to the Donau. The charity
+ signs over all blinded identifiers and key pairs which it has received from
+ the donor. The signature affirms that the charity wants the donation
+ receipts to be issued on its behalf. *)
+let charity_donation_confirmation : int32 = 1501_l
+
+(** The signature is made by a charity to request information about its status
+ from a Donau. It is not over anything in particular and is just there for
+ access control. *)
+let charity_get_info : int32 = 1502_l
+
+(** Signature over messages to delete in the mailbox service *)
+let mailbox_messages_delete : int32 = 1551_l
+
+(** Signature for mailbox registration request *)
+let mailbox_register : int32 = 1552_l
diff --git a/.jjconflict-side-0/src/time.ml b/.jjconflict-side-0/src/time.ml
new file mode 100644
index 00000000..3c5af371
--- /dev/null
+++ b/.jjconflict-side-0/src/time.ml
@@ -0,0 +1,151 @@
+let uint64_max = Int64.minus_one
+
+module Relative = struct
+ type t = Int64.t
+
+ let forever = uint64_max
+ let zero = 0L
+ let compare = Int64.unsigned_compare
+ let min a b = if compare a b < 0 then a else b
+ let max a b = if compare a b > 0 then a else b
+
+ (* forever if either argument is forever or on overflow; otherwise a + b *)
+ let add a b =
+ if a = forever || b = forever then forever
+ else
+ let v = Int64.add a b in
+ if compare v a < 0 then forever else v
+
+ (* zero if a <= b, or forever if a is forever; otherwise a - b *)
+ let sub a b =
+ if compare a b <= 0 then zero
+ else if a = forever then forever
+ else Int64.sub a b
+
+ let of_s s =
+ let v = Int64.mul s 1_000_000L in
+ if Int64.unsigned_div v 1_000_000L <> s then forever else v
+
+ let bin = Bin.neint64
+ let bin_nbo = Bin.beint64
+
+ (* TODO should be in NBO here? *)
+ let caqti =
+ let encode v = Ok v in
+ let decode v = Ok v in
+ Caqti_type.custom ~encode ~decode Caqti_type.int64
+
+ (* TODO
+ reject negative / non-integer values
+ cap value at 2^53 - 1 inclusive *)
+ let jsont =
+ let jsont =
+ let forever_jsont =
+ let dec s =
+ match s with
+ | "forever" -> forever
+ | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
+ in
+ let enc _t = "forever" in
+ Jsont.map ~dec ~enc Jsont.string
+ in
+ let num_jsont = Jsont.int64 in
+ let enc t = if t = forever then forever_jsont else num_jsont in
+ Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc ()
+ in
+ Jsont.Object.map ~kind:"RelativeTime" Fun.id
+ |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id
+ |> Jsont.Object.finish
+end
+
+module Absolute = struct
+ type t = Int64.t
+
+ let never = uint64_max
+ let zero = 0L
+ let compare = Int64.unsigned_compare
+ let min a b = if compare a b < 0 then a else b
+ let max a b = if compare a b > 0 then a else b
+
+ (* zero if a >= b; never if b=never; otherwise b - a *)
+ let diff a b =
+ if compare a b >= 0 then zero
+ else if b = never then never
+ else Int64.sub b a
+
+ (* never if either argument is never/forever or on overflow; otherwise t + d *)
+ let add t d =
+ if t = never || d = never then never
+ else
+ let v = Int64.add t d in
+ if compare v t < 0 then never else v
+
+ (* zero if t <= d, or never if t is never; otherwise t - d *)
+ let sub t d =
+ if compare t d <= 0 then zero
+ else if t = never then never
+ else Int64.sub t d
+
+ let of_s s =
+ let v = Int64.mul s 1_000_000L in
+ if Int64.unsigned_div v 1_000_000L <> s then never else v
+
+ let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s
+end
+
+module Timestamp = struct
+ type t = Int64.t
+
+ let never = uint64_max
+ let zero = 0L
+ let compare = Int64.unsigned_compare
+
+ (* zero if a >= b; never if b=never; otherwise b - a *)
+ let diff a b =
+ if compare a b >= 0 then zero
+ else if b = never then never
+ else Int64.sub b a
+
+ let of_s s =
+ let v = Int64.mul s 1_000_000L in
+ if Int64.unsigned_div v 1_000_000L <> s then never else v
+
+ let to_s t =
+ if t = never then None else Some (Int64.unsigned_div t 1_000_000L)
+
+ let of_absolute a =
+ if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L)
+
+ let of_ptime v = v |> Absolute.of_ptime |> of_absolute
+ let bin = Bin.neint64
+ let bin_nbo = Bin.beint64
+
+ let caqti =
+ let encode v = Ok v in
+ let decode v = Ok v in
+ Caqti_type.custom ~encode ~decode Caqti_type.int64
+
+ let jsont =
+ let jsont =
+ let never_jsont =
+ let dec s =
+ match s with
+ | "never" -> never
+ | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
+ in
+ let enc _t = "never" in
+ Jsont.map ~dec ~enc Jsont.string
+ in
+ let num_jsont =
+ Jsont.map
+ ~dec:(fun n -> of_s n)
+ ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s)
+ Jsont.int64
+ in
+ let enc t = if t = never then never_jsont else num_jsont in
+ Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc ()
+ in
+ Jsont.Object.map ~kind:"Timestamp" Fun.id
+ |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id
+ |> Jsont.Object.finish
+end
diff --git a/.jjconflict-side-0/src/time.mli b/.jjconflict-side-0/src/time.mli
new file mode 100644
index 00000000..180df904
--- /dev/null
+++ b/.jjconflict-side-0/src/time.mli
@@ -0,0 +1,54 @@
+module Relative : sig
+ type t
+
+ val forever : t
+ val zero : t
+ val compare : t -> t -> int
+ val min : t -> t -> t
+ val max : t -> t -> t
+ val add : t -> t -> t
+ val sub : t -> t -> t
+ val of_s : int64 -> t
+
+ (* - *)
+ val bin : t Bin.t
+ val bin_nbo : t Bin.t
+ val caqti : t Caqti_type.t
+ val jsont : t Jsont.t
+end
+
+module Absolute : sig
+ type t
+
+ val never : t
+ val zero : t
+ val compare : t -> t -> int
+ val min : t -> t -> t
+ val max : t -> t -> t
+ val diff : t -> t -> Relative.t
+ val add : t -> Relative.t -> t
+ val sub : t -> Relative.t -> t
+ val of_s : int64 -> t
+ val of_ptime : Ptime.t -> t
+end
+
+module Timestamp : sig
+ type t
+
+ val never : t
+ val zero : t
+ val compare : t -> t -> int
+ val diff : t -> t -> Relative.t
+ val of_s : int64 -> t
+
+ (* none if t = never *)
+ val to_s : t -> int64 option
+ val of_absolute : Absolute.t -> t
+ val of_ptime : Ptime.t -> t
+
+ (* - *)
+ val bin : t Bin.t
+ val bin_nbo : t Bin.t
+ val caqti : t Caqti_type.t
+ val jsont : t Jsont.t
+end
diff --git a/.jjconflict-side-0/src/timestamp.ml b/.jjconflict-side-0/src/timestamp.ml
new file mode 100644
index 00000000..1a942758
--- /dev/null
+++ b/.jjconflict-side-0/src/timestamp.ml
@@ -0,0 +1 @@
+include Time.Timestamp
diff --git a/.jjconflict-side-0/src/util.ml b/.jjconflict-side-0/src/util.ml
new file mode 100644
index 00000000..c690a009
--- /dev/null
+++ b/.jjconflict-side-0/src/util.ml
@@ -0,0 +1,62 @@
+module Log_reporter = struct
+ let detail_tag : string Logs.Tag.def =
+ Logs.Tag.def "Detail tag" ~doc:"" Fmt.string
+
+ let detail s = Logs.Tag.(empty |> add detail_tag s)
+ let time_anchor = Ptime_clock.now () |> Ptime.to_span
+
+ let color_of_log_level = function
+ | Logs.App -> `White
+ | Error -> `Red
+ | Warning -> `Yellow
+ | Info -> `Blue
+ | Debug -> `Magenta
+
+ let reporter : Logs.reporter =
+ let open Fmt in
+ let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%04.02f")) in
+ let pp_header ppf v =
+ let color = color_of_log_level (fst v) in
+ let pp = styled (`Fg color) Logs.pp_header in
+ pf ppf "%a" pp v
+ in
+ let pp_src_name =
+ let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in
+ fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v
+ in
+ let pp_detail = option (styled `Green (fmt " (%s)")) in
+ let report src lvl ~over k msgf =
+ let ppf =
+ match lvl with
+ | Logs.App -> stdout
+ | Error | Warning | Info | Debug -> stderr
+ in
+ let k _ppf = over (); k () in
+ let with_detail h tags k user_fmt =
+ let detail = Option.bind tags (Logs.Tag.find detail_tag) in
+ let timestamp =
+ Ptime.sub_span (Ptime_clock.now ()) time_anchor
+ |> Option.map Ptime.to_float_s
+ |> Option.value ~default:0.
+ in
+ let k ppf = kpf k ppf "%a@." pp_detail detail in
+ let k ppf = kpf k ppf user_fmt in
+ kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h)
+ pp_src_name src
+ in
+ msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
+ in
+ { report }
+
+ (* TODO logs
+ - vif shouldn't use/set the default reporter
+ - Log.err all `Internal_server_error response *)
+ let setup () =
+ let level = Some Logs.Info in
+ Logs.set_level ~all:false level;
+ Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
+ Logs.Src.set_level Logs.default level;
+ Logs_threaded.enable ();
+ Logs.set_reporter reporter;
+ ()
+end
diff --git a/.jjconflict-side-0/test/auditor_public_key b/.jjconflict-side-0/test/auditor_public_key
new file mode 100644
index 00000000..4b97fccf
--- /dev/null
+++ b/.jjconflict-side-0/test/auditor_public_key
@@ -0,0 +1 @@
+A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0
diff --git a/.jjconflict-side-0/test/crypto.ml b/.jjconflict-side-0/test/crypto.ml
new file mode 100644
index 00000000..83650235
--- /dev/null
+++ b/.jjconflict-side-0/test/crypto.ml
@@ -0,0 +1,32 @@
+let round_trip s =
+ let s' = s |> B32.encode |> B32.decode |> Result.get_ok in
+ match s' = s with
+ | false -> Fmt.failwith "b32 round trip failure: @\nin :`%S`@\nout:`%S`" s' s
+ | true -> ()
+
+let () =
+ let s = String.init 0xff Char.chr in
+ round_trip s;
+ let s_l = List.init 0x0f (fun i -> String.init i Char.chr) in
+ List.iter round_trip s_l; ()
+
+(* TODO *)
+(* test vectors from:
+ https://git.gnunet.org/gnunet/gnunet/file/src/cli/util/crypto-test-vectors.json.html *)
+
+let () =
+ let input = "91JPRV3F5GG4EKJNDSJQ8" in
+ let expected =
+ "D0R24RZ1TPASVQ2NY56CT8AJDYZE9ZGDB0GVZ05E9D4YGZQW2RC5YFPQ0Q86EPW836DY7VYQTNFFJT3ZR2K508F4JVS5JNJKYN2MMFR"
+ in
+ let output =
+ input
+ |> B32.decode
+ |> Result.get_ok
+ |> Hash.H64.hash
+ |> Hash.H64.to_octets
+ |> B32.encode
+ in
+ assert (output = expected);
+
+ ()
diff --git a/.jjconflict-side-0/test/dune b/.jjconflict-side-0/test/dune
new file mode 100644
index 00000000..1aa7506a
--- /dev/null
+++ b/.jjconflict-side-0/test/dune
@@ -0,0 +1,16 @@
+(test
+ (name test)
+ (modules test)
+ (libraries mte fmt))
+
+(test
+ (name crypto)
+ (modules crypto)
+ (libraries mte fmt))
+
+; TODO
+; cram test?
+; gcc -o a.out ./test/signatures.c && ./a.out > a.output
+; rm ./a.out
+; dune exec ./test/test.exe > b.output
+; cmp -l a.output b.output
diff --git a/.jjconflict-side-0/test/offline_management.sh b/.jjconflict-side-0/test/offline_management.sh
new file mode 100755
index 00000000..119c46e0
--- /dev/null
+++ b/.jjconflict-side-0/test/offline_management.sh
@@ -0,0 +1,58 @@
+#!/bin/bash
+
+set -e
+
+a="/tmp/a.json"
+b="/tmp/b.json"
+
+url="http://localhost:3434"
+auditor_pub=$(<"./test/auditor_public_key")
+master_key="./default/master_offline_private_key"
+zero_euro="EUR:0.0"
+
+offline_tool() {
+ dune exec offline -- "$@" > /dev/null
+}
+
+offline_tool download --output $a --url $url"/management/keys"
+offline_tool sign \
+--master_key $master_key \
+--input $a \
+--output $b
+offline_tool upload --input $b --url $url"/management/keys"
+echo "[OK] /management/keys"
+
+offline_tool enable-auditor \
+--master_key $master_key \
+--output $b \
+--auditor_url "auditor.example.com" \
+--auditor_name "auditor example" \
+--auditor_pub $auditor_pub \
+--validity_start 0
+offline_tool upload --input $b --url $url"/management/auditors"
+echo "[OK] /management/auditors"
+
+offline_tool wire-fee \
+--master_key $master_key \
+--output $b \
+--wire_method "xxx" \
+--fee_start 0 \
+--fee_end 99999999 \
+--closing_fee $zero_euro \
+--wire_fee $zero_euro
+offline_tool upload --input $b --url $url"/management/wire-fee"
+echo "[OK] /management/wire-fee"
+
+offline_tool global-fees \
+--master_key $master_key \
+--output $b \
+--start_date 0 \
+--end_date 99999999 \
+--history_fee $zero_euro \
+--account_fee $zero_euro \
+--purse_fee $zero_euro \
+--history_expiration 9999999 \
+--purse_account_limit 1 \
+--purse_timeout 9999999
+offline_tool upload --input $b --url $url"/management/global-fees"
+echo "[OK] /management/global-fees"
diff --git a/.jjconflict-side-0/test/signatures.c b/.jjconflict-side-0/test/signatures.c
new file mode 100644
index 00000000..bcebe993
--- /dev/null
+++ b/.jjconflict-side-0/test/signatures.c
@@ -0,0 +1,55 @@
+#include
+#include
+
+struct H64 {
+ uint8_t hash[64];
+};
+struct Hhh {
+ struct H64 hash;
+};
+struct Purpose {
+ uint32_t size;
+ uint32_t purpose;
+};
+
+struct PS {
+ struct Purpose purpose;
+ struct Hhh h;
+ uint32_t noreveal_index;
+};
+
+int main(void) {
+ struct Purpose purpose;
+ struct PS ps;
+
+ purpose.size = 3 * 4 + 64;
+ purpose.purpose = 1050;
+
+ struct Hhh h = {
+ .hash = {
+ .hash = {
+ 1 , 2 , 3 , 4 , 5, 6, 7, 8,
+ 9 , 10, 11, 12, 13, 14, 15, 16,
+ 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, 40,
+ 41, 42, 43, 44, 45, 46, 47, 48,
+ 49, 50, 51, 52, 53, 54, 55, 56,
+ 57, 58, 59, 60, 61, 62, 63, 64
+ }
+ }
+ };
+
+ uint32_t noreveal_index = 0;
+
+ ps.purpose = purpose;
+ ps.h = h;
+ ps.noreveal_index = noreveal_index;
+
+
+ fwrite(&ps, sizeof(ps), 1, stdout);
+
+ // printf("\n");
+
+ return 0;
+}
diff --git a/.jjconflict-side-0/test/test.ml b/.jjconflict-side-0/test/test.ml
new file mode 100644
index 00000000..b1c2810b
--- /dev/null
+++ b/.jjconflict-side-0/test/test.ml
@@ -0,0 +1,115 @@
+let () = Mirage_crypto_rng_unix.use_default ()
+
+let () =
+ let priv = Mirage_crypto_pk.Rsa.generate ~bits:2048 () in
+ let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in
+ let () =
+ let open Crypto.RsaPrivateKey in
+ let priv' = priv |> to_octets |> of_octets |> Result.get_ok in
+ assert (to_octets priv = to_octets priv')
+ in
+ let () =
+ let open Crypto.RsaPublicKey in
+ let pub' = pub |> to_octets |> of_octets |> Result.get_ok in
+ assert (to_octets pub = to_octets pub')
+ in
+ ()
+
+let () =
+ let open Api in
+ let check jsont s =
+ let encode v = encode jsont v |> Result.get_ok in
+ let decode v = decode jsont v |> Result.get_ok in
+ let ts = decode s in
+ let s' = encode ts in
+ let ts' = decode s' in
+ let s'' = encode ts' in
+ assert (String.equal s' s'')
+ in
+ let check_bad jsont s =
+ let decode = decode jsont in
+ assert (Result.is_error (decode s))
+ in
+ check Timestamp.jsont {|{"t_s": 123456780}|};
+ check Timestamp.jsont {|{"t_s": "never"}|};
+ check_bad Timestamp.jsont {|{"t_s": "123456780"}|};
+ check_bad Timestamp.jsont {|{"t_s": "agagou"}|};
+
+ (* CS not implemented *)
+ check_bad DenominationKey.jsont
+ {|{"cipher": "CS", "age_mask": 18, "cs_pub": "ouhagag"}|};
+
+ (* TODO test with a valid rsa_pub value *)
+ (* TODO handle "rsa pub_of_octets failure" correctly *)
+ (* check_bad DenominationKey.jsont
+ {|{"cipher": "RSA", "age_mask": 18, "rsa_pub": "agagouh"}|}; *)
+ ()
+
+let () =
+ let open Amount in
+ let v =
+ make ~sign:(Some Sign_plus) ~currency:"EUR" ~value:(Int64.of_int 25)
+ ~fraction:(Int32.of_int 678)
+ |> Result.get_ok
+ in
+ let s = to_string v in
+ let v' = of_string s |> Result.get_ok in
+ assert (v = v');
+ let r = of_string {|~EUR:4.9|} in
+ assert (Result.is_error r);
+ let r = of_string {|+EUR:4.99999999999999999999999|} in
+ assert (Result.is_error r);
+ ()
+
+let () =
+ let open Headers_lib.If_none_match in
+ let ok_l =
+ [
+ "*";
+ "\"foo\"";
+ "W/\"foo\"";
+ "\"foo\", \"bar\"";
+ " , W/\"x\" , W/\"y\" , \"z\"";
+ ", \"one\" , \"two\" , \"three\"";
+ "W/\"a\" , ";
+ "W/\"a\" , \"b\"";
+ ]
+ in
+ let bad_l =
+ [
+ "";
+ "foo";
+ "W/foo";
+ "W/\"unterminated";
+ "\"foo\", W/";
+ "* , \"bar\"";
+ "\"a\" \"b\"";
+ "W/\"a\" W/\"b\"";
+ "\"fo\x7Fo\"";
+ " W/\"a\"";
+ "W/\"a\" ";
+ ]
+ in
+ let check_ok input = assert (Result.is_ok (parse input)) in
+ let check_bad input = assert (Result.is_error (parse input)) in
+ List.iter check_ok ok_l;
+ List.iter check_bad bad_l;
+
+ ()
+
+(*
+
+let () =
+ let 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/dbinit.sh b/.jjconflict-side-0/tools/dbinit.sh
new file mode 100755
index 00000000..4d74bc9a
--- /dev/null
+++ b/.jjconflict-side-0/tools/dbinit.sh
@@ -0,0 +1,100 @@
+#!/bin/bash
+
+# TODO
+# use specific commit
+
+# usage:
+# `create_database`
+# create a `taler-exchange` database
+# `fetch`
+# fetch all *.sql and *.sql.in files from GNU Taler exchange repository (latest commit)
+# `init`
+# initialize taler-exchange database (create tables, ...)
+# `taler-exchange` database must already be created
+#
+
+
+set -e
+
+taler_repo_url="https://git-www.taler.net/exchange.git/"
+
+tmp_dir="/tmp/taler_exchange"
+out_dir="./_taler_exchange_sql"
+init_sql="${out_dir}/init.sql"
+drop_sql="${out_dir}/drop.sql"
+
+# psql parameter
+host="localhost"
+port=5432
+username="mte"
+dbname="taler-exchange"
+
+fetch() {
+ git clone --depth 1 $taler_repo_url $tmp_dir
+}
+
+process() {
+ source_dir="${tmp_dir}/src/exchangedb"
+ sql_in_files=(
+ "procedures.sql"
+ "exchange-0002.sql"
+ "exchange-0003.sql"
+ "exchange-0004.sql"
+ )
+ for file in "${sql_in_files[@]}"; do
+ file_in="${source_dir}/${file}.in"
+ file_out="${source_dir}/${file}"
+ gcc -E -P -undef -I "$source_dir" - < "$file_in" \
+ 2>/dev/null \
+ > "$file_out"
+ done
+ # order is important
+ files=(
+ "versioning.sql"
+ "exchange-0001.sql"
+ "exchange-0002.sql"
+ "exchange-0003.sql"
+ "exchange-0004.sql"
+ "exchange-0005.sql"
+ "procedures.sql"
+ )
+ mkdir -p "$out_dir"
+ cat "${source_dir}/drop.sql" > "$drop_sql"
+ echo "" > "$init_sql"
+ for file in "${files[@]}"; do
+ cat "${source_dir}/${file}" >> "$init_sql"
+ done
+}
+
+# ? "NOTICE: function xxx() does not exist, skipping"
+init() {
+ psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$init_sql
+}
+
+drop_schema() {
+ psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$drop_sql
+}
+
+create_database() {
+ createdb --host=$host --port=$port --username=$username --password $dbname
+}
+
+drop_database() {
+ dropdb --host=$host --port=$port --username=$username --password $dbname
+}
+
+if [[ $# -eq 0 ]]; then
+ echo "no argument" >&2
+ exit 1
+fi
+
+cmd=$1
+case "$cmd" in
+ fetch) fetch "$@"; exit 0;;
+ process) process "$@"; exit 0;;
+ init) init "$@"; exit 0;;
+ drop_schema) drop_schema "$@"; exit 0;;
+ create_database) create_database "$@"; exit 0;;
+ drop_database) drop_database "$@"; exit 0;;
+ *) echo "Unknown command: $cmd" >&2; exit 1;;
+esac
diff --git a/.jjconflict-side-0/tools/dune b/.jjconflict-side-0/tools/dune
new file mode 100644
index 00000000..4f5057ca
--- /dev/null
+++ b/.jjconflict-side-0/tools/dune
@@ -0,0 +1,11 @@
+(executable
+ (public_name offline)
+ (name offline)
+ (modules offline offline_impl)
+ (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
+
+(executable
+ (public_name gen_signatures_registry)
+ (name gen_signatures_registry)
+ (modules gen_signatures_registry)
+ (libraries angstrom bos fmt))
diff --git a/.jjconflict-side-0/tools/gen_signatures_registry.ml b/.jjconflict-side-0/tools/gen_signatures_registry.ml
new file mode 100644
index 00000000..3d3a4191
--- /dev/null
+++ b/.jjconflict-side-0/tools/gen_signatures_registry.ml
@@ -0,0 +1,109 @@
+module Recfile = struct
+ (* rudimentary recfile parser
+ https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
+ open Angstrom
+
+ type field = {
+ k: string;
+ v: string;
+ }
+
+ type record = field list
+
+ let newline = char '\n'
+ let is_newline = function '\n' -> true | _ -> false
+
+ let field_name =
+ let first_char =
+ satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
+ in
+ let subsequent_char =
+ satisfy (function
+ | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
+ | _ -> false)
+ in
+ lift2
+ (fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
+ first_char (many subsequent_char)
+
+ (* todo handle '\' escape and '+' on next line *)
+ let field_value = take_till is_newline <* newline
+
+ let field =
+ let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
+ let blanks = skip_many1 blank in
+ lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
+
+ let blank = newline *> return ()
+ let comment = (char '#' *> take_till is_newline <* newline) *> return ()
+ let record = many1 field
+
+ let records =
+ let sep =
+ (* at least one blank line *)
+ skip_many comment *> blank *> skip_many (comment <|> blank)
+ in
+ sep_by1 sep record
+
+ let recfile : record list t =
+ skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
+
+ let parse s = parse_string ~consume:All recfile s
+end
+
+let url =
+ "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
+
+let registry_file = "registry.rec"
+
+let download () =
+ let open Bos in
+ let res =
+ OS.Cmd.run Cmd.(v "curl" % "-s" % "-o" % registry_file % "-X" % "GET" % url)
+ in
+ match res with
+ | Error (`Msg s) -> Fmt.failwith "download failure: %s" s
+ | Ok () -> ()
+
+let read_file file = In_channel.with_open_bin file In_channel.input_all
+
+type purpose = {
+ number: int32;
+ name: string;
+ comment: string;
+}
+
+let parse_purposes records =
+ records
+ |> List.filter_map (fun l ->
+ match l with
+ | a :: b :: c :: _ -> (
+ let open Recfile in
+ match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
+ | false -> None
+ | true ->
+ Some
+ {
+ number= Int32.of_int (int_of_string a.v);
+ name= String.lowercase_ascii b.v;
+ comment= c.v;
+ })
+ | _ -> None)
+ |> List.filter (fun v -> v.number >= 1000_l)
+
+let () =
+ download ();
+ let content = read_file registry_file in
+ match Recfile.parse content with
+ | Error msg -> Fmt.failwith "Recfile parse error: %s" msg
+ | Ok records ->
+ let purposes = parse_purposes records in
+ let header =
+ {|(* This file was generated from the GANA database:
+ https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|}
+ in
+ let pp ppf { number; name; comment } =
+ Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
+ in
+ Fmt.pr "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
+ ()
diff --git a/.jjconflict-side-0/tools/offline.ml b/.jjconflict-side-0/tools/offline.ml
new file mode 100644
index 00000000..5864bd0c
--- /dev/null
+++ b/.jjconflict-side-0/tools/offline.ml
@@ -0,0 +1,301 @@
+(* TODO
+ better cmd doc
+ change arguments: '_' -> '-'
+
+ 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 master_key =
+ let doc = "Master offline Eddsa private key file." in
+ Arg.(required & opt (some file) None & info [ "master_key" ] ~doc)
+
+let input =
+ let doc = "input file" in
+ Arg.(required & opt (some file) None & info [ "i"; "input" ] ~doc)
+
+let output =
+ let doc = "output file" in
+ Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
+
+let url =
+ let doc = "url" in
+ Arg.(required & opt (some string) None & info [ "url" ] ~doc)
+
+let setup_cmd =
+ let doc = "Generate offline master keys" in
+ let output =
+ let doc = "output file" in
+ Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
+ in
+ Cmd.make (Cmd.info "setup" ~doc)
+ @@
+ let+ output = output in
+ setup ~output
+
+let download_cmd =
+ let doc = "GET" in
+ Cmd.make (Cmd.info "download" ~doc)
+ @@
+ let+ output = output and+ url = url in
+ download ~output ~url
+
+let upload_cmd =
+ let doc = "POST" in
+ Cmd.make (Cmd.info "upload" ~doc)
+ @@
+ let+ input = input and+ url = url in
+ upload ~input ~url
+
+let sign_cmd =
+ let doc = "Sign FutureKeysResponse." in
+ Cmd.make (Cmd.info "sign" ~doc)
+ @@
+ let+ input = input and+ output = output and+ master_key = master_key in
+ sign ~input ~output ~master_key
+
+let revoke_denom_cmd =
+ let doc = "Revoke denomination." in
+ let h_denom =
+ let doc = "hash of denomination public key" in
+ Arg.(required & pos 0 (some string) None & info [] ~doc)
+ in
+ Cmd.make (Cmd.info "revoke-denom" ~doc)
+ @@
+ let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
+ revoke_denom ~output ~master_key ~h_denom
+
+let revoke_signkey_cmd =
+ let doc = "Revoke signkey." in
+ let signkey =
+ let doc = "public signing key" in
+ Arg.(required & pos 0 (some eddsa_pub) None & info [] ~doc)
+ in
+ Cmd.make (Cmd.info "revoke-signkey" ~doc)
+ @@
+ let+ output = output and+ master_key = master_key and+ signkey = signkey in
+ revoke_signkey ~output ~master_key ~signkey
+
+let enable_auditor_cmd =
+ let doc = "Enable auditor." in
+ let auditor_url =
+ Arg.(required & opt (some string) None & info [ "auditor_url" ])
+ in
+ let auditor_name =
+ Arg.(required & opt (some string) None & info [ "auditor_name" ])
+ in
+ let auditor_pub =
+ Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
+ in
+ let validity_start =
+ Arg.(required & opt (some timestamp) None & info [ "validity_start" ])
+ in
+ Cmd.make (Cmd.info "enable-auditor" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ auditor_url = auditor_url
+ and+ auditor_name = auditor_name
+ and+ auditor_pub = auditor_pub
+ and+ validity_start = validity_start in
+ enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
+ ~validity_start
+
+let disable_auditor_cmd =
+ let doc = "Disable auditor." in
+ let auditor_pub =
+ Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
+ in
+ let validity_end =
+ Arg.(required & opt (some timestamp) None & info [ "validity_end" ])
+ in
+ Cmd.make (Cmd.info "disable-auditor" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ auditor_pub = auditor_pub
+ and+ validity_end = validity_end in
+ disable_auditor ~output ~master_key ~auditor_pub ~validity_end
+
+let wire_fee_cmd =
+ let doc = "Provides wire fee configuration." in
+ let wire_method =
+ Arg.(required & opt (some string) None & info [ "wire_method" ])
+ in
+ let fee_start =
+ Arg.(required & opt (some timestamp) None & info [ "fee_start" ])
+ in
+ let fee_end =
+ Arg.(required & opt (some timestamp) None & info [ "fee_end" ])
+ in
+ let closing_fee =
+ Arg.(required & opt (some amount) None & info [ "closing_fee" ])
+ in
+ let wire_fee =
+ Arg.(required & opt (some amount) None & info [ "wire_fee" ])
+ in
+ Cmd.make (Cmd.info "wire-fee" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ wire_method = wire_method
+ and+ fee_start = fee_start
+ and+ fee_end = fee_end
+ and+ closing_fee = closing_fee
+ and+ wire_fee = wire_fee in
+ Offline_impl.wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end
+ ~closing_fee ~wire_fee
+
+let global_fees_cmd =
+ let doc = "Provides global fee configuration." in
+ let start_date =
+ Arg.(required & opt (some timestamp) None & info [ "start_date" ])
+ in
+ let end_date =
+ Arg.(required & opt (some timestamp) None & info [ "end_date" ])
+ in
+ let history_fee =
+ Arg.(required & opt (some amount) None & info [ "history_fee" ])
+ in
+ let account_fee =
+ Arg.(required & opt (some amount) None & info [ "account_fee" ])
+ in
+ let purse_fee =
+ Arg.(required & opt (some amount) None & info [ "purse_fee" ])
+ in
+ let history_expiration =
+ Arg.(
+ required & opt (some relative_time) None & info [ "history_expiration" ])
+ in
+ let purse_account_limit =
+ Arg.(required & opt (some int) None & info [ "purse_account_limit" ])
+ in
+ let purse_timeout =
+ Arg.(required & opt (some relative_time) None & info [ "purse_timeout" ])
+ in
+ Cmd.make (Cmd.info "global-fees" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ start_date = start_date
+ and+ end_date = end_date
+ and+ history_fee = history_fee
+ and+ account_fee = account_fee
+ and+ purse_fee = purse_fee
+ and+ history_expiration = history_expiration
+ and+ purse_account_limit = purse_account_limit
+ and+ purse_timeout = purse_timeout in
+ global_fees ~output ~master_key ~start_date ~end_date ~history_fee
+ ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
+ ~purse_timeout
+
+let drain_cmd =
+ let doc =
+ "Drain profits from the exchange. The actual drain requires running the \
+ `taler-exchange-drain` tool."
+ in
+ let debit_account_section =
+ Arg.(required & opt (some string) None & info [ "debit_account_section" ])
+ in
+ let credit_payto_uri =
+ Arg.(required & opt (some string) None & info [ "credit_payto_uri" ])
+ in
+ let wtid = Arg.(required & opt (some b32) None & info [ "wtid" ]) in
+ let date = Arg.(required & opt (some timestamp) None & info [ "date" ]) in
+ let amount = Arg.(required & opt (some amount) None & info [ "amount" ]) in
+ Cmd.make (Cmd.info "drain" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ debit_account_section = debit_account_section
+ and+ credit_payto_uri = credit_payto_uri
+ and+ wtid = wtid
+ and+ date = date
+ and+ amount = amount in
+ drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid ~date
+ ~amount
+
+let cli =
+ let info =
+ let doc = "MTE Offline CLI tool" in
+ Cmd.info "mte-offline" ~doc
+ in
+ Cmd.group info
+ [
+ setup_cmd;
+ download_cmd;
+ sign_cmd;
+ upload_cmd;
+ revoke_denom_cmd;
+ revoke_signkey_cmd;
+ enable_auditor_cmd;
+ disable_auditor_cmd;
+ wire_fee_cmd;
+ global_fees_cmd;
+ drain_cmd;
+ ]
+
+let main () = Cmd.eval_result cli
+let () = if !Sys.interactive then () else exit (main ())
diff --git a/.jjconflict-side-0/tools/offline_impl.ml b/.jjconflict-side-0/tools/offline_impl.ml
new file mode 100644
index 00000000..d8a1fa18
--- /dev/null
+++ b/.jjconflict-side-0/tools/offline_impl.ml
@@ -0,0 +1,368 @@
+open Syntax
+open Hash
+
+module Future_keys = struct
+ open Crypto
+ open Api
+
+ let verify =
+ let verify_future_denom ~sm_denom_pub
+ FutureDenom.
+ {
+ section_name;
+ value= _;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit= _;
+ stamp_expire_legal= _;
+ denom_pub;
+ fee_withdraw= _;
+ fee_deposit= _;
+ fee_refresh= _;
+ fee_refund= _;
+ denom_secmod_sig;
+ } =
+ let h_denom_pub =
+ DenominationHash.hash (DenominationKey.to_octets denom_pub)
+ in
+ let h_section_name = Hash.Cstring.H64.hash section_name in
+ let anchor_time = stamp_start in
+ let duration_withdraw =
+ Timestamp.diff stamp_start stamp_expire_withdraw
+ in
+ let open Signatures.DenominationKeyAnnouncement in
+ verify_f
+ ~f:(EddsaSignature.verify ~key:sm_denom_pub)
+ denom_secmod_sig
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+ in
+ let verify_future_signkey ~sm_signkey_pub
+ FutureSignKey.
+ { key; stamp_start; stamp_expire; stamp_end= _; signkey_secmod_sig } =
+ let exchange_pub = key in
+ let anchor_time = stamp_start in
+ let duration = Timestamp.diff stamp_start stamp_expire in
+ let open Signatures.SigningKeyAnnouncement in
+ verify_f
+ ~f:(EddsaSignature.verify ~key:sm_signkey_pub)
+ signkey_secmod_sig
+ { exchange_pub; anchor_time; duration }
+ in
+ fun our_master_public_key
+ FutureKeysResponse.
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub;
+ denom_secmod_public_key;
+ signkey_secmod_public_key;
+ }
+ ->
+ let* () =
+ match master_pub = our_master_public_key with
+ | false ->
+ Fmt.error
+ "master public key of the future key response does not match ours"
+ | true -> Ok ()
+ in
+ let* () =
+ list_iter
+ (verify_future_denom ~sm_denom_pub:denom_secmod_public_key)
+ future_denoms
+ in
+ let* () =
+ list_iter
+ (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key)
+ future_signkeys
+ in
+ Ok ()
+
+ let make =
+ let denom_signature ~master_key
+ FutureDenom.
+ {
+ section_name= _;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig= _;
+ } =
+ let octets = DenominationKey.to_octets denom_pub in
+ let h_denom_pub = DenominationHash.hash octets in
+ let master_sig =
+ let open Signatures.DenominationKeyValidity in
+ let master = EddsaPrivateKey.(pub_of_priv master_key) in
+ sign_f
+ ~f:(EddsaSignature.sign ~key:master_key)
+ {
+ master;
+ start= stamp_start;
+ expire_withdraw= stamp_expire_withdraw;
+ expire_spend= stamp_expire_deposit;
+ expire_legal= stamp_expire_legal;
+ value;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_hash= h_denom_pub;
+ }
+ in
+ DenomSignature.{ h_denom_pub; master_sig }
+ in
+ let signkey_signature ~master_key
+ FutureSignKey.
+ { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
+ let master_sig =
+ let open Signatures.ExchangeSigningKeyValidity in
+ sign_f
+ ~f:(EddsaSignature.sign ~key:master_key)
+ {
+ start= stamp_start;
+ expire= stamp_expire;
+ end_= stamp_end;
+ signkey_pub= key;
+ }
+ in
+ SignKeySignature.{ key; master_sig }
+ in
+ fun ~master_key
+ FutureKeysResponse.
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub= _;
+ denom_secmod_public_key= _;
+ signkey_secmod_public_key= _;
+ }
+ ->
+ let denom_sigs = List.map (denom_signature ~master_key) future_denoms in
+ let signkey_sigs =
+ List.map (signkey_signature ~master_key) future_signkeys
+ in
+ MasterSignatures.{ denom_sigs; signkey_sigs }
+end
+
+(* -- *)
+
+let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_err_msg
+
+let write_file fname content =
+ Bos.OS.File.write (Fpath.v fname) content |> unwrap_err_msg
+
+let read_master_key_file filename =
+ let* master_key = read_file filename in
+ Crypto.EddsaPrivateKey.of_octets master_key
+
+let download ~output ~url =
+ let open Bos in
+ OS.Cmd.run Cmd.(v "curl" % "--silent" % "-o" % output % "-X" % "GET" % url)
+ |> unwrap_err_msg
+
+let upload ~input ~url =
+ let open Bos in
+ OS.Cmd.run
+ Cmd.(
+ v "curl"
+ % "--silent"
+ % "-i"
+ % "-X"
+ % "POST"
+ % "-H"
+ % "Content-Type: application/json"
+ % "--data"
+ % ("@" ^ input)
+ % url)
+ |> unwrap_err_msg
+
+let setup ~output =
+ 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* () = Future_keys.verify master_pub future_keys_response in
+ let master_signatures = Future_keys.make ~master_key future_keys_response in
+ let* s = Api.encode Api.MasterSignatures.jsont master_signatures in
+ let* () = write_file output s in
+ Ok ()
+
+let revoke_denom ~output ~master_key ~h_denom =
+ let* key = read_master_key_file master_key in
+ let* h_denom_pub = DenominationHash.of_b32 h_denom in
+ let denom_revoke =
+ let master_sig =
+ let open Signatures.MasterDenominationKeyRevocation in
+ sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub }
+ in
+ Api.DenomRevocationSignature.{ master_sig }
+ in
+ let* s = Api.encode Api.DenomRevocationSignature.jsont denom_revoke in
+ let* () = write_file output s in
+ Ok ()
+
+let revoke_signkey ~output ~master_key ~signkey =
+ let* key = read_master_key_file master_key in
+ let signkey_revoke =
+ let master_sig =
+ let open Signatures.MasterSigningKeyRevocation in
+ sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey }
+ in
+ Api.SignkeyRevocationSignature.{ master_sig }
+ in
+ let* s = Api.encode Api.SignkeyRevocationSignature.jsont signkey_revoke in
+ let* () = write_file output s in
+ Ok ()
+
+let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
+ ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
+ ~purse_timeout =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let* purse_account_limit =
+ match
+ purse_account_limit >= 0
+ && purse_account_limit <= Int32.to_int Int32.max_int
+ with
+ | false -> Error "invalid purse_account_limit value"
+ | true -> Ok (Int32.of_int purse_account_limit)
+ in
+ let master_sig =
+ let open Signatures.GlobalFees in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ }
+ in
+ let global_fees =
+ Api.GlobalFees.
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ master_sig;
+ }
+ in
+ let* s = Api.encode Api.GlobalFees.jsont global_fees in
+ let* () = write_file output s in
+ Ok ()
+
+let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
+ ~validity_start =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig =
+ let open Signatures.MasterAddAuditor in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ start_date= validity_start;
+ auditor_pub;
+ h_auditor_url= Hash.Cstring.H64.hash auditor_url;
+ }
+ in
+ let v =
+ Api.AuditorSetupMessage.
+ { auditor_url; auditor_name; auditor_pub; master_sig; validity_start }
+ in
+ let* s = Api.encode Api.AuditorSetupMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
+
+let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig =
+ let open Signatures.MasterDelAuditor in
+ sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
+ in
+ let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in
+ let* s = Api.encode Api.AuditorTeardownMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
+
+let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
+ ~wire_fee =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig_wire =
+ let open Signatures.MasterWireFee in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ h_wire_method= Hash.Cstring.H64.hash wire_method;
+ start_date= fee_start;
+ end_date= fee_end;
+ closing_fee;
+ wire_fee;
+ }
+ in
+ let v =
+ Api.WireFeeSetupMessage.
+ {
+ wire_method;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ master_sig_wire;
+ }
+ in
+ let* s = Api.encode Api.WireFeeSetupMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
+
+let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid
+ ~date ~amount =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig =
+ let open Signatures.MasterDrainProfit in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ wtid;
+ date;
+ amount;
+ h_section= Hash.Cstring.H64.hash debit_account_section;
+ h_payto= FullPaytoHash.hash credit_payto_uri;
+ }
+ in
+ let v =
+ Api.DrainProfitsMessage.
+ {
+ debit_account_section;
+ credit_payto_uri;
+ wtid;
+ master_sig;
+ date;
+ amount;
+ }
+ in
+ let* s = Api.encode Api.DrainProfitsMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
diff --git a/.jjconflict-side-1/.gitignore b/.jjconflict-side-1/.gitignore
new file mode 100644
index 00000000..7aeab444
--- /dev/null
+++ b/.jjconflict-side-1/.gitignore
@@ -0,0 +1,5 @@
+_build
+_taler_exchange_sql
+assets
+secrets
+!secrets/.keep
diff --git a/.jjconflict-side-1/.ocamlformat b/.jjconflict-side-1/.ocamlformat
new file mode 100644
index 00000000..43b12fc0
--- /dev/null
+++ b/.jjconflict-side-1/.ocamlformat
@@ -0,0 +1,15 @@
+version=0.28.1
+exp-grouping=preserve
+type-decl=sparse
+break-infix=fit-or-vertical
+break-collection-expressions=fit-or-vertical
+break-sequences=false
+break-infix-before-func=false
+dock-collection-brackets=true
+break-separators=after
+field-space=tight
+if-then-else=compact
+break-sequences=false
+sequence-blank-line=compact
+exp-grouping=preserve
+sequence-blank-line=preserve-one
diff --git a/.jjconflict-side-1/LICENSE b/.jjconflict-side-1/LICENSE
new file mode 100644
index 00000000..be3f7b28
--- /dev/null
+++ b/.jjconflict-side-1/LICENSE
@@ -0,0 +1,661 @@
+ GNU AFFERO GENERAL PUBLIC LICENSE
+ Version 3, 19 November 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+ A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate. Many developers of free software are heartened and
+encouraged by the resulting cooperation. However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+ The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community. It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server. Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+ An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals. This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing under
+this license.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU Affero General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Remote Network Interaction; Use with the GNU General Public License.
+
+ Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your version
+supports such interaction) an opportunity to receive the Corresponding
+Source of your version by providing access to the Corresponding Source
+from a network server at no charge, through some standard or customary
+means of facilitating copying of software. This Corresponding Source
+shall include the Corresponding Source for any work covered by version 3
+of the GNU General Public License that is incorporated pursuant to the
+following paragraph.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU Affero General Public License from time to time. Such new versions
+will be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see .
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for the
+specific requirements.
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU AGPL, see
+.
diff --git a/.jjconflict-side-1/default/assets/mte.conf b/.jjconflict-side-1/default/assets/mte.conf
new file mode 100644
index 00000000..a6c89c52
--- /dev/null
+++ b/.jjconflict-side-1/default/assets/mte.conf
@@ -0,0 +1,74 @@
+[currency-EUR]
+enabled= YES
+code= EUR
+name= euro
+fractional_input_digits= 2
+fractional_normal_digits= 2
+fractional_trailing_zero_digits= 2
+alt_unit_names= "{"0":"€","3":"k€"}"
+
+[exchange]
+currency = EUR
+currency_round_unit = EUR:0.01
+db = postgres
+attribute_encryption_key = "deadbeef"
+port = 3434
+bind_to = localhost
+master_public_key = "SJ0NYND22VQP3MP7FM754RDX8HCKVWAXTHY9SQNBTPRJZ2SPM2S0"
+stefan_abs = EUR:0.00
+stefan_log = EUR:0.00
+stefan_lin = 0.00
+aggregator_idle_sleep_interval = "1 hour"
+closer_idle_sleep_interval = "1 hour"
+transfer_idle_sleep_interval = "1 hour"
+wirewatch_idle_sleep_interval = "1 hour"
+signkey_legal_duration = "1 year"
+max_keys_caching = "4 weeks"
+enable_kyc = NO
+terms_etag = "0"
+privacy_etag = "0"
+base_url = "http://localhost:3434/"
+
+[exchangedb]
+idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds"
+legal_reserve_expiration_time = "1 year"
+aggregator_shift = "1 year"
+max_aml_program_runtime = "1 year"
+default_purse_limit = 9999
+
+[exchangedb-postgres]
+config = "pgx://mte:hunter2@localhost:5432/taler-exchange"
+
+[taler-exchange-secmod-rsa]
+lookahead_sign = "1 year"
+overlap_duration = "1 year"
+
+[taler-exchange-secmod-eddsa]
+lookahead_sign = "1 year"
+overlap_duration = "1 year"
+
+[coin_kudo_1]
+value= EUR:0.01
+duration_withdraw= "1 year"
+duration_spend= "1 year"
+duration_legal= "1 year"
+fee_withdraw= EUR:0.00
+fee_deposit= EUR:0.00
+fee_refresh= EUR:0.00
+fee_refund= EUR:0.00
+cipher= RSA
+rsa_keysize= 2048
+age_restricted= NO
+
+[coin_kudo_2]
+value= EUR:0.02
+duration_withdraw= "1 year"
+duration_spend= "1 year"
+duration_legal= "1 year"
+fee_withdraw= EUR:0.00
+fee_deposit= EUR:0.00
+fee_refresh= EUR:0.00
+fee_refund= EUR:0.00
+cipher= RSA
+rsa_keysize= 2048
+age_restricted= NO
diff --git a/.jjconflict-side-1/default/assets/privacy/en/0.md b/.jjconflict-side-1/default/assets/privacy/en/0.md
new file mode 100644
index 00000000..9c8e6b15
--- /dev/null
+++ b/.jjconflict-side-1/default/assets/privacy/en/0.md
@@ -0,0 +1,8 @@
+# Privacy Policy
+
+Welcome!
+This is a placeholder Privacy Policy file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/assets/privacy/en/0.txt b/.jjconflict-side-1/default/assets/privacy/en/0.txt
new file mode 100644
index 00000000..9c8e6b15
--- /dev/null
+++ b/.jjconflict-side-1/default/assets/privacy/en/0.txt
@@ -0,0 +1,8 @@
+# Privacy Policy
+
+Welcome!
+This is a placeholder Privacy Policy file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/assets/terms/en/0.md b/.jjconflict-side-1/default/assets/terms/en/0.md
new file mode 100644
index 00000000..033a5937
--- /dev/null
+++ b/.jjconflict-side-1/default/assets/terms/en/0.md
@@ -0,0 +1,8 @@
+# Terms of Service
+
+Welcome!
+This is a placeholder Terms of Service file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/assets/terms/en/0.txt b/.jjconflict-side-1/default/assets/terms/en/0.txt
new file mode 100644
index 00000000..033a5937
--- /dev/null
+++ b/.jjconflict-side-1/default/assets/terms/en/0.txt
@@ -0,0 +1,8 @@
+# Terms of Service
+
+Welcome!
+This is a placeholder Terms of Service file.
+
+
+------------------------------------------
+MTE - the MirageOS Taler Exchange
diff --git a/.jjconflict-side-1/default/master_offline_private_key b/.jjconflict-side-1/default/master_offline_private_key
new file mode 100644
index 00000000..739df007
Binary files /dev/null and b/.jjconflict-side-1/default/master_offline_private_key differ
diff --git a/.jjconflict-side-1/dune-project b/.jjconflict-side-1/dune-project
new file mode 100644
index 00000000..1aadd32c
--- /dev/null
+++ b/.jjconflict-side-1/dune-project
@@ -0,0 +1,45 @@
+(lang dune 3.20)
+
+(name mte)
+
+(generate_opam_files true)
+
+; (source
+; (github username/reponame))
+
+(authors "Olivier Pierre ")
+
+(maintainers "Olivier Pierre ")
+
+(license AGPL-3.0-only)
+
+; (documentation https://url/to/documentation)
+
+(package
+ (name mte)
+ (synopsis "MTE - the MirageOS Taler Exchange")
+ (description "A GNU Taler exchange implementation with the unikernel framework MirageOS")
+ (tags
+ ("GNU Taler" MirageOS unikernel OCaml crypto))
+ (depends
+ (ocaml (>= 5.3))
+ base32
+ caqti
+ caqti-miou
+ caqti-driver-pgx
+ crunch
+ vif
+ jsont
+ cohttp
+ fmt
+ bin
+ angstrom
+ mirage-crypto
+ digestif
+ duration
+ jsont
+ cohttp
+ ptime
+ logs
+ (ocamlformat :with-dev-setup)
+ ))
diff --git a/.jjconflict-side-1/mte.opam b/.jjconflict-side-1/mte.opam
new file mode 100644
index 00000000..53820528
--- /dev/null
+++ b/.jjconflict-side-1/mte.opam
@@ -0,0 +1,48 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "MTE - the MirageOS Taler Exchange"
+description:
+ "A GNU Taler exchange implementation with the unikernel framework MirageOS"
+maintainer: ["Olivier Pierre "]
+authors: ["Olivier Pierre "]
+license: "AGPL-3.0-only"
+tags: ["GNU Taler" "MirageOS" "unikernel" "OCaml" "crypto"]
+depends: [
+ "dune" {>= "3.20"}
+ "ocaml" {>= "5.3"}
+ "base32"
+ "caqti"
+ "caqti-miou"
+ "caqti-driver-pgx"
+ "crunch"
+ "vif"
+ "jsont"
+ "cohttp"
+ "fmt"
+ "bin"
+ "angstrom"
+ "mirage-crypto"
+ "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/secrets/.keep b/.jjconflict-side-1/secrets/.keep
new file mode 100644
index 00000000..e69de29b
diff --git a/.jjconflict-side-1/src/amount.ml b/.jjconflict-side-1/src/amount.ml
new file mode 100644
index 00000000..c5e06082
--- /dev/null
+++ b/.jjconflict-side-1/src/amount.ml
@@ -0,0 +1,127 @@
+(* TODO
+ have a currency agnostic amount_lib.ml
+ and specialize amount.ml to Config.currency??
+
+ have safe amount arithmetic *)
+type sign =
+ | Sign_plus
+ | Sign_minus
+
+type t = {
+ sign: sign option;
+ currency: string;
+ value: Int64.t;
+ fraction: Int32.t;
+}
+
+let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
+
+(* TODO
+ the constraint is on the number of digits,
+ so this wrong if leading 0s
+ this depends on currency..? *)
+let fraction_upper_bound = Int32.of_int 100_000_000
+
+let make ~sign ~currency ~value ~fraction =
+ if value < Int64.zero then Error "value is negative"
+ else if fraction < Int32.zero then Error "fraction is negative"
+ else if value > value_upper_bound then Error "value is greater than 2^52-1"
+ else if fraction >= fraction_upper_bound then
+ Error "fraction has more than 8 decimal digits"
+ else Ok { sign; currency; value; fraction }
+
+module Parse = struct
+ open Angstrom
+
+ let sign =
+ char '+' *> return (Some Sign_plus)
+ <|> char '-' *> return (Some Sign_minus)
+ <|> return None
+
+ let currency =
+ take_while1 (function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false)
+ >>= fun s ->
+ match String.length s < 12 with
+ | false -> fail "currency is more than 11 characters"
+ | true -> return s
+
+ let int64 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int64.of_string_opt
+ >>= function
+ | None -> fail "value is not a valid int64"
+ | Some n when n >= value_upper_bound -> fail "value is greater than 2^52-1"
+ | Some n -> return n
+
+ let int32 =
+ take_while1 (function '0' .. '9' -> true | _ -> false)
+ >>| Int32.of_string_opt
+ >>= function
+ | None -> fail "fraction is not a valid int32"
+ | Some n when n >= fraction_upper_bound ->
+ fail "fraction is greater than 10^8-1"
+ | Some n -> return n
+
+ let amount =
+ lift4
+ (fun sign currency value fraction ->
+ make ~sign ~currency ~value ~fraction)
+ sign currency
+ (char ':' *> int64)
+ (char '.' *> int32 <|> return 0_l)
+ <* end_of_input
+
+ let f s = parse_string ~consume:Consume.All amount s |> Result.join
+end
+
+let of_string = Parse.f
+
+let pp =
+ let open Fmt in
+ let pp_sign ppf = function
+ | Sign_plus -> char ppf '+'
+ | Sign_minus -> char ppf '-'
+ in
+ fun ppf { sign; currency; value; fraction } ->
+ (* TODO
+ depends on the currency's number of fraction digits
+ assumes value and fraction are in bounds *)
+ pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction
+
+let to_string = Fmt.str "%a" pp
+
+(* - *)
+
+let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
+
+(* byte length of currency string *)
+let currency_len = 12
+
+let pad_currency_string s =
+ let len = String.length s in
+ assert (len < currency_len);
+ let b = Bytes.make 12 '\x00' in
+ Bytes.blit_string s 0 b 0 len;
+ Bytes.to_string b
+
+(* binary decoding unused? *)
+let make_exn value fraction currency =
+ match make ~sign:None ~currency ~value ~fraction with
+ | Error _ -> Fmt.failwith "Amount of binary data failure"
+ | Ok v -> v
+
+let bin =
+ let open Bin in
+ record make_exn
+ |+ field neint64 (fun t -> t.value)
+ |+ field neint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
+ |> sealr
+
+let bin_nbo =
+ let open Bin in
+ record make_exn
+ |+ field beint64 (fun t -> t.value)
+ |+ field beint32 (fun t -> t.fraction)
+ |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
+ |> sealr
diff --git a/.jjconflict-side-1/src/amount.mli b/.jjconflict-side-1/src/amount.mli
new file mode 100644
index 00000000..f055430c
--- /dev/null
+++ b/.jjconflict-side-1/src/amount.mli
@@ -0,0 +1,27 @@
+type sign =
+ | Sign_plus
+ | Sign_minus
+
+type t = private {
+ sign: sign option;
+ currency: string;
+ value: Int64.t;
+ fraction: Int32.t;
+}
+
+val make :
+ sign:sign option ->
+ currency:string ->
+ value:Int64.t ->
+ fraction:Int32.t ->
+ (t, string) result
+
+val pp : Format.formatter -> t -> unit
+val to_string : t -> string
+val of_string : string -> (t, string) result
+
+(* - *)
+val jsont : t Jsont.t
+val bin : t Bin.t
+val bin_nbo : t Bin.t
+(* [caqti] is in pg_type.ml *)
diff --git a/.jjconflict-side-1/src/api.ml b/.jjconflict-side-1/src/api.ml
new file mode 100644
index 00000000..c57643d1
--- /dev/null
+++ b/.jjconflict-side-1/src/api.ml
@@ -0,0 +1,1374 @@
+(* 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 jsont const string
+ `name: "taler-exchange"` *)
+ name: string;
+ implementation: string option;
+ currency: string;
+ shopping_url: string option;
+ open_banking_gateway: string option;
+ currency_specification: CurrencySpecification.t;
+ aml_spa_dialect: string option;
+ }
+
+ let jsont =
+ let make version name implementation currency shopping_url
+ open_banking_gateway currency_specification aml_spa_dialect =
+ {
+ version;
+ name;
+ implementation;
+ currency;
+ shopping_url;
+ open_banking_gateway;
+ currency_specification;
+ aml_spa_dialect;
+ }
+ in
+ let version v = v.version in
+ let name v = v.name in
+ let implementation v = v.implementation in
+ let currency v = v.currency in
+ let shopping_url v = v.shopping_url in
+ let open_banking_gateway v = v.open_banking_gateway in
+ let currency_specification v = v.currency_specification in
+ let aml_spa_dialect v = v.aml_spa_dialect in
+ map ~kind:"ExchangeVersionResponse" make
+ |> mem "version" Jsont.string ~enc:version
+ |> mem "name" Jsont.string ~enc:name
+ |> mem "implementation" (Jsont.option Jsont.string) ~enc:implementation
+ |> mem "currency" Jsont.string ~enc:currency
+ |> mem "shopping_url" (Jsont.option Jsont.string) ~enc:shopping_url
+ |> mem "open_banking_gateway"
+ (Jsont.option Jsont.string)
+ ~enc:open_banking_gateway
+ |> mem "currency_specification" CurrencySpecification.jsont
+ ~enc:currency_specification
+ |> mem "aml_spa_dialect" (Jsont.option Jsont.string) ~enc:aml_spa_dialect
+ |> finish
+end
+
+let config =
+ let currency_specification =
+ let open Config.Currency in
+ let alt_unit_names =
+ Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+ in
+ CurrencySpecification.
+ {
+ name= v.name;
+ num_fractional_input_digits= v.fractional_input_digits;
+ num_fractional_normal_digits= v.fractional_normal_digits;
+ num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits;
+ alt_unit_names;
+ common_amounts= [];
+ }
+ in
+ ExchangeVersionResponse.
+ {
+ version= protocol_version;
+ name= "taler-exchange";
+ currency= Config.currency;
+ currency_specification;
+ implementation= None;
+ shopping_url= None;
+ open_banking_gateway= None;
+ aml_spa_dialect= None;
+ }
+
+module RsaDenominationKey = struct
+ type t = {
+ age_mask: int;
+ rsa_pub: RsaPublicKey.t;
+ }
+
+ let jsont =
+ let make age_mask rsa_pub = { age_mask; rsa_pub } in
+ let age_mask v = v.age_mask in
+ let rsa_pub v = v.rsa_pub in
+ Jsont.Object.map ~kind:"RsaDenominationKey" make
+ |> Jsont.Object.mem "age_mask" Jsont.int ~enc:age_mask
+ |> Jsont.Object.mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
+ |> Jsont.Object.finish
+end
+
+(* ! Clause Schnorr cipher is not supported *)
+module DenominationKey = struct
+ type t = Rsa of RsaDenominationKey.t
+
+ let to_octets = function Rsa denom -> RsaPublicKey.to_octets denom.rsa_pub
+
+ let of_cs _v =
+ Jsont.Error.msg Jsont.Meta.none "CSDenominationKey are not supported"
+
+ let of_rsa v = Rsa v
+
+ let jsont =
+ let rsa = Case.map "RSA" RsaDenominationKey.jsont ~dec:of_rsa in
+ let cs = Case.map "CS" zero ~dec:of_cs in
+ let enc_case = function Rsa v -> Case.value rsa v in
+ let cases = Case.[ make rsa; make cs ] in
+ map ~kind:"DenominationKey" Fun.id
+ |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
+ |> finish
+end
+
+module FutureSignKey = struct
+ type t = {
+ key: EddsaPublicKey.t;
+ stamp_start: Timestamp.t;
+ stamp_expire: Timestamp.t;
+ stamp_end: Timestamp.t;
+ signkey_secmod_sig: SigningKeyAnnouncement.t;
+ }
+
+ let jsont =
+ let make key stamp_start stamp_expire stamp_end signkey_secmod_sig =
+ { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+ in
+ let key v = v.key in
+ let stamp_start v = v.stamp_start in
+ let stamp_expire v = v.stamp_expire in
+ let stamp_end v = v.stamp_end in
+ let signkey_secmod_sig v = v.signkey_secmod_sig in
+ map ~kind:"FutureSignKey" make
+ |> mem "key" EddsaPublicKey.jsont ~enc:key
+ |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+ |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
+ |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
+ |> mem "signkey_secmod_sig" SigningKeyAnnouncement.jsont
+ ~enc:signkey_secmod_sig
+ |> finish
+end
+
+module FutureDenom = struct
+ type t = {
+ section_name: string;
+ value: Amount.t;
+ stamp_start: Timestamp.t;
+ stamp_expire_withdraw: Timestamp.t;
+ stamp_expire_deposit: Timestamp.t;
+ stamp_expire_legal: Timestamp.t;
+ denom_pub: DenominationKey.t;
+ fee_withdraw: Amount.t;
+ fee_deposit: Amount.t;
+ fee_refresh: Amount.t;
+ fee_refund: Amount.t;
+ denom_secmod_sig: DenominationKeyAnnouncement.t;
+ }
+
+ let jsont =
+ let make section_name value stamp_start stamp_expire_withdraw
+ stamp_expire_deposit stamp_expire_legal denom_pub fee_withdraw
+ fee_deposit fee_refresh fee_refund denom_secmod_sig =
+ {
+ section_name;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig;
+ }
+ in
+ let section_name t = t.section_name in
+ let value t = t.value in
+ let stamp_start t = t.stamp_start in
+ let stamp_expire_withdraw t = t.stamp_expire_withdraw in
+ let stamp_expire_deposit t = t.stamp_expire_deposit in
+ let stamp_expire_legal t = t.stamp_expire_legal in
+ let denom_pub t = t.denom_pub in
+ let fee_withdraw t = t.fee_withdraw in
+ let fee_deposit t = t.fee_deposit in
+ let fee_refresh t = t.fee_refresh in
+ let fee_refund t = t.fee_refund in
+ let denom_secmod_sig t = t.denom_secmod_sig in
+ map ~kind:"FutureDenom" make
+ |> mem "section_name" Jsont.string ~enc:section_name
+ |> mem "value" Amount.jsont ~enc:value
+ |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+ |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
+ |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
+ |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
+ |> mem "denom_pub" DenominationKey.jsont ~enc:denom_pub
+ |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
+ |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
+ |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
+ |> mem "fee_refund" Amount.jsont ~enc:fee_refund
+ |> mem "denom_secmod_sig" DenominationKeyAnnouncement.jsont
+ ~enc:denom_secmod_sig
+ |> finish
+end
+
+module FutureKeysResponse = struct
+ type t = {
+ future_denoms: FutureDenom.t list;
+ future_signkeys: FutureSignKey.t list;
+ master_pub: EddsaPublicKey.t;
+ denom_secmod_public_key: EddsaPublicKey.t;
+ signkey_secmod_public_key: EddsaPublicKey.t;
+ }
+
+ let jsont =
+ let make future_denoms future_signkeys master_pub denom_secmod_public_key
+ signkey_secmod_public_key =
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub;
+ denom_secmod_public_key;
+ signkey_secmod_public_key;
+ }
+ in
+ let future_denoms t = t.future_denoms in
+ let future_signkeys t = t.future_signkeys in
+ let master_pub t = t.master_pub in
+ let denom_secmod_public_key t = t.denom_secmod_public_key in
+ let signkey_secmod_public_key t = t.signkey_secmod_public_key in
+ map ~kind:"FutureKeysResponse" make
+ |> mem "future_denoms" (Jsont.list FutureDenom.jsont) ~enc:future_denoms
+ |> mem "future_signkeys"
+ (Jsont.list FutureSignKey.jsont)
+ ~enc:future_signkeys
+ |> mem "master_pub" EddsaPublicKey.jsont ~enc:master_pub
+ |> mem "denom_secmod_public_key" EddsaPublicKey.jsont
+ ~enc:denom_secmod_public_key
+ |> mem "signkey_secmod_public_key" EddsaPublicKey.jsont
+ ~enc:signkey_secmod_public_key
+ |> finish
+end
+
+module SignKeySignature = struct
+ type t = {
+ key: EddsaPublicKey.t;
+ master_sig: ExchangeSigningKeyValidity.t;
+ }
+
+ let jsont =
+ let make key master_sig = { key; master_sig } in
+ let key v = v.key in
+ let master_sig v = v.master_sig in
+ map ~kind:"SignKeySignature" make
+ |> mem "key" EddsaPublicKey.jsont ~enc:key
+ |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
+ |> finish
+end
+
+module DenomSignature = struct
+ type t = {
+ h_denom_pub: DenominationHash.t;
+ master_sig: DenominationKeyValidity.t;
+ }
+
+ let jsont =
+ let make h_denom_pub master_sig = { h_denom_pub; master_sig } in
+ let h_denom_pub v = v.h_denom_pub in
+ let master_sig v = v.master_sig in
+ map ~kind:"DenomSignature" make
+ |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub
+ |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
+ |> finish
+end
+
+module MasterSignatures = struct
+ type t = {
+ denom_sigs: DenomSignature.t list;
+ signkey_sigs: SignKeySignature.t list;
+ }
+
+ let jsont =
+ let make denom_sigs signkey_sigs = { denom_sigs; signkey_sigs } in
+ let denom_sigs v = v.denom_sigs in
+ let signkey_sigs v = v.signkey_sigs in
+ map ~kind:"MasterSignatures" make
+ |> mem "denom_sigs" (Jsont.list DenomSignature.jsont) ~enc:denom_sigs
+ |> mem "signkey_sigs" (Jsont.list SignKeySignature.jsont) ~enc:signkey_sigs
+ |> finish
+end
+
+module DenomRevocationSignature = struct
+ type t = { master_sig: MasterDenominationKeyRevocation.t }
+
+ let jsont =
+ let make master_sig = { master_sig } in
+ let enc v = v.master_sig in
+ map ~kind:"DenomRevocationSignature" make
+ |> mem "master_sig" MasterDenominationKeyRevocation.jsont ~enc
+ |> finish
+end
+
+module SignkeyRevocationSignature = struct
+ type t = { master_sig: MasterSigningKeyRevocation.t }
+
+ let jsont =
+ let make master_sig = { master_sig } in
+ let enc v = v.master_sig in
+ map ~kind:"SignkeyRevocationSignature" make
+ |> mem "master_sig" MasterSigningKeyRevocation.jsont ~enc
+ |> finish
+end
+
+module AuditorSetupMessage = struct
+ type t = {
+ auditor_url: string;
+ auditor_name: string;
+ auditor_pub: EddsaPublicKey.t;
+ master_sig: MasterAddAuditor.t;
+ (* TODO monotonic time
+ something about using monotonic system time here! *)
+ validity_start: Timestamp.t;
+ }
+
+ let jsont =
+ let make auditor_url auditor_name auditor_pub master_sig validity_start =
+ { auditor_url; auditor_name; auditor_pub; master_sig; validity_start }
+ in
+ let auditor_url v = v.auditor_url in
+ let auditor_name v = v.auditor_name in
+ let auditor_pub v = v.auditor_pub in
+ let master_sig v = v.master_sig in
+ let validity_start v = v.validity_start in
+ map ~kind:"AuditorSetupMessage" make
+ |> mem "auditor_url" Jsont.string ~enc:auditor_url
+ |> mem "auditor_name" Jsont.string ~enc:auditor_name
+ |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub
+ |> mem "master_sig" MasterAddAuditor.jsont ~enc:master_sig
+ |> mem "validity_start" Timestamp.jsont ~enc:validity_start
+ |> finish
+end
+
+module AuditorTeardownMessage = struct
+ type t = {
+ master_sig: MasterDelAuditor.t;
+ (* TODO monotonic time *)
+ validity_end: Timestamp.t;
+ }
+
+ let jsont =
+ let make master_sig validity_end = { master_sig; validity_end } in
+ let master_sig v = v.master_sig in
+ let validity_end v = v.validity_end in
+ map ~kind:"AuditorTeardownMessage" make
+ |> mem "master_sig" MasterDelAuditor.jsont ~enc:master_sig
+ |> mem "validity_end" Timestamp.jsont ~enc:validity_end
+ |> finish
+end
+
+module WireFeeSetupMessage = struct
+ type t = {
+ wire_method: string;
+ master_sig_wire: MasterWireFee.t;
+ fee_start: Timestamp.t;
+ fee_end: Timestamp.t;
+ closing_fee: Amount.t;
+ wire_fee: Amount.t;
+ }
+
+ let jsont =
+ let make wire_method master_sig_wire fee_start fee_end closing_fee wire_fee
+ =
+ {
+ wire_method;
+ master_sig_wire;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ }
+ in
+ let wire_method v = v.wire_method in
+ let master_sig_wire v = v.master_sig_wire in
+ let fee_start v = v.fee_start in
+ let fee_end v = v.fee_end in
+ let closing_fee v = v.closing_fee in
+ let wire_fee v = v.wire_fee in
+ map ~kind:"WireFeeSetupMessage" make
+ |> mem "wire_method" Jsont.string ~enc:wire_method
+ |> mem "master_sig_wire" MasterWireFee.jsont ~enc:master_sig_wire
+ |> mem "fee_start" Timestamp.jsont ~enc:fee_start
+ |> mem "fee_end" Timestamp.jsont ~enc:fee_end
+ |> mem "closing_fee" Amount.jsont ~enc:closing_fee
+ |> mem "wire_fee" Amount.jsont ~enc:wire_fee
+ |> finish
+end
+
+module GlobalFees = struct
+ type t = {
+ start_date: Timestamp.t;
+ end_date: Timestamp.t;
+ history_fee: Amount.t;
+ account_fee: Amount.t;
+ purse_fee: Amount.t;
+ history_expiration: Time.Relative.t;
+ purse_account_limit: int32;
+ purse_timeout: Time.Relative.t;
+ master_sig: GlobalFees.t;
+ }
+
+ let jsont =
+ let make start_date end_date history_fee account_fee purse_fee
+ history_expiration purse_account_limit purse_timeout master_sig =
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ }
+ in
+ let start_date v = v.start_date in
+ let end_date v = v.end_date in
+ let history_fee v = v.history_fee in
+ let account_fee v = v.account_fee in
+ let purse_fee v = v.purse_fee in
+ let history_expiration v = v.history_expiration in
+ let purse_account_limit v = v.purse_account_limit in
+ let purse_timeout v = v.purse_timeout in
+ let master_sig v = v.master_sig in
+ map ~kind:"GlobalFees" make
+ |> mem "start_date" Timestamp.jsont ~enc:start_date
+ |> mem "end_date" Timestamp.jsont ~enc:end_date
+ |> mem "history_fee" Amount.jsont ~enc:history_fee
+ |> mem "account_fee" Amount.jsont ~enc:account_fee
+ |> mem "purse_fee" Amount.jsont ~enc:purse_fee
+ |> mem "history_expiration" Time.Relative.jsont ~enc:history_expiration
+ |> mem "purse_account_limit" Jsont.int32 ~enc:purse_account_limit
+ |> mem "purse_timeout" Time.Relative.jsont ~enc:purse_timeout
+ |> mem "master_sig" GlobalFees.jsont ~enc:master_sig
+ |> finish
+end
+
+module WireSetupMessage = struct
+ type t = {
+ payto_uri: string;
+ master_sig_wire: MasterWireDetails.t;
+ master_sig_add: MasterAddWire.t;
+ (* TODO monotonic time *)
+ validity_start: Timestamp.t;
+ bank_label: string option;
+ priority: int option;
+ }
+
+ let jsont =
+ let make payto_uri master_sig_wire master_sig_add validity_start bank_label
+ priority =
+ {
+ payto_uri;
+ master_sig_wire;
+ master_sig_add;
+ validity_start;
+ bank_label;
+ priority;
+ }
+ in
+ let payto_uri v = v.payto_uri in
+ let master_sig_wire v = v.master_sig_wire in
+ let master_sig_add v = v.master_sig_add in
+ let validity_start v = v.validity_start in
+ let bank_label v = v.bank_label in
+ let priority v = v.priority in
+ map ~kind:"WireSetupMessage" make
+ |> mem "payto_uri" Jsont.string ~enc:payto_uri
+ |> mem "master_sig_wire" MasterWireDetails.jsont ~enc:master_sig_wire
+ |> mem "master_sig_add" MasterAddWire.jsont ~enc:master_sig_add
+ |> mem "validity_start" Timestamp.jsont ~enc:validity_start
+ |> mem "bank_label" (Jsont.option Jsont.string) ~enc:bank_label
+ |> mem "priority" (Jsont.option Jsont.int) ~enc:priority
+ |> finish
+end
+
+module WireTeardownMessage = struct
+ type t = {
+ payto_uri: string;
+ master_sig_del: MasterDelWire.t;
+ (* TODO monotonic time *)
+ validity_end: Timestamp.t;
+ }
+
+ let jsont =
+ let make payto_uri master_sig_del validity_end =
+ { payto_uri; master_sig_del; validity_end }
+ in
+ let payto_uri v = v.payto_uri in
+ let master_sig_del v = v.master_sig_del in
+ let validity_end v = v.validity_end in
+ map ~kind:"WireTeardownMessage" make
+ |> mem "payto_uri" Jsont.string ~enc:payto_uri
+ |> mem "master_sig_del" MasterDelWire.jsont ~enc:master_sig_del
+ |> mem "validity_end" Timestamp.jsont ~enc:validity_end
+ |> finish
+end
+
+module DrainProfitsMessage = struct
+ type t = {
+ wtid: B32.t;
+ debit_account_section: string;
+ credit_payto_uri: string;
+ date: Timestamp.t;
+ amount: Amount.t;
+ master_sig: MasterDrainProfit.t;
+ }
+
+ let jsont =
+ let make debit_account_section credit_payto_uri wtid master_sig date amount
+ =
+ {
+ debit_account_section;
+ credit_payto_uri;
+ wtid;
+ master_sig;
+ date;
+ amount;
+ }
+ in
+ let debit_account_section v = v.debit_account_section in
+ let credit_payto_uri v = v.credit_payto_uri in
+ let wtid v = v.wtid in
+ let master_sig v = v.master_sig in
+ let date v = v.date in
+ let amount v = v.amount in
+ map ~kind:"DrainProfitsMessage" make
+ |> mem "debit_account_section" Jsont.string ~enc:debit_account_section
+ |> mem "credit_payto_uri" Jsont.string ~enc:credit_payto_uri
+ |> mem "wtid" B32.jsont ~enc:wtid
+ |> mem "master_sig" MasterDrainProfit.jsont ~enc:master_sig
+ |> mem "date" Timestamp.jsont ~enc:date
+ |> mem "amount" Amount.jsont ~enc:amount
+ |> finish
+end
+
+module AmlOfficerSetup = struct
+ type t = {
+ officer_pub: EddsaPublicKey.t;
+ master_sig: MasterAmlOfficerStatus.t;
+ officer_name: string;
+ is_active: bool;
+ read_only: bool;
+ change_date: Timestamp.t;
+ }
+
+ let jsont =
+ let make officer_pub officer_name is_active read_only master_sig change_date
+ =
+ {
+ officer_pub;
+ officer_name;
+ is_active;
+ read_only;
+ master_sig;
+ change_date;
+ }
+ in
+ let officer_pub v = v.officer_pub in
+ let officer_name v = v.officer_name in
+ let is_active v = v.is_active in
+ let read_only v = v.read_only in
+ let master_sig v = v.master_sig in
+ let change_date v = v.change_date in
+ map ~kind:"AmlOfficerSetup" make
+ |> mem "officer_pub" EddsaPublicKey.jsont ~enc:officer_pub
+ |> mem "officer_name" Jsont.string ~enc:officer_name
+ |> mem "is_active" Jsont.bool ~enc:is_active
+ |> mem "read_only" Jsont.bool ~enc:read_only
+ |> mem "master_sig" MasterAmlOfficerStatus.jsont ~enc:master_sig
+ |> mem "change_date" Timestamp.jsont ~enc:change_date
+ |> finish
+end
+
+module ExchangePartnerSetupRequest = struct
+ type t = {
+ partner_base_url: string;
+ partner_pub: EddsaPublicKey.t;
+ wad_frequency: Time.Relative.t;
+ master_sig: PartnerConfiguration.t;
+ start_date: Timestamp.t;
+ end_date: Timestamp.t;
+ wad_fee: Amount.t;
+ }
+
+ let jsont =
+ let make partner_base_url partner_pub wad_frequency master_sig start_date
+ end_date wad_fee =
+ {
+ partner_base_url;
+ partner_pub;
+ wad_frequency;
+ master_sig;
+ start_date;
+ end_date;
+ wad_fee;
+ }
+ in
+ let partner_base_url v = v.partner_base_url in
+ let partner_pub v = v.partner_pub in
+ let wad_frequency v = v.wad_frequency in
+ let master_sig v = v.master_sig in
+ let start_date v = v.start_date in
+ let end_date v = v.end_date in
+ let wad_fee v = v.wad_fee in
+ map ~kind:"ExchangePartnerSetupRequest" make
+ |> mem "partner_base_url" Jsont.string ~enc:partner_base_url
+ |> mem "partner_pub" EddsaPublicKey.jsont ~enc:partner_pub
+ |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency
+ |> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig
+ |> mem "start_date" Timestamp.jsont ~enc:start_date
+ |> mem "end_date" Timestamp.jsont ~enc:end_date
+ |> mem "wad_fee" Amount.jsont ~enc:wad_fee
+ |> finish
+end
+
+(* -- types for /keys -- *)
+
+module ExchangePartnerListEntry = struct
+ type t = {
+ partner_base_url: string;
+ partner_master_pub: EddsaPublicKey.t;
+ wad_fee: Amount.t;
+ wad_frequency: Time.Relative.t;
+ start_date: Timestamp.t;
+ end_date: Timestamp.t;
+ master_sig: WadPartnerSignature.t;
+ }
+
+ let jsont =
+ let make partner_base_url partner_master_pub wad_fee wad_frequency
+ start_date end_date master_sig =
+ {
+ partner_base_url;
+ partner_master_pub;
+ wad_fee;
+ wad_frequency;
+ start_date;
+ end_date;
+ master_sig;
+ }
+ in
+ let partner_base_url v = v.partner_base_url in
+ let partner_master_pub v = v.partner_master_pub in
+ let wad_fee v = v.wad_fee in
+ let wad_frequency v = v.wad_frequency in
+ let start_date v = v.start_date in
+ let end_date v = v.end_date in
+ let master_sig v = v.master_sig in
+ map ~kind:"ExchangePartnerListEntry" make
+ |> mem "partner_base_url" Jsont.string ~enc:partner_base_url
+ |> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub
+ |> mem "wad_fee" Amount.jsont ~enc:wad_fee
+ |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency
+ |> mem "start_date" Timestamp.jsont ~enc:start_date
+ |> mem "end_date" Timestamp.jsont ~enc:end_date
+ |> mem "master_sig" WadPartnerSignature.jsont ~enc:master_sig
+ |> finish
+end
+
+module AggregateTransferFee = struct
+ type t = {
+ wire_fee: Amount.t;
+ closing_fee: Amount.t;
+ start_date: Timestamp.t;
+ end_date: Timestamp.t;
+ sig_: MasterWireFee.t;
+ }
+
+ let jsont =
+ let make wire_fee closing_fee start_date end_date sig_ =
+ { wire_fee; closing_fee; start_date; end_date; sig_ }
+ in
+ let wire_fee v = v.wire_fee in
+ let closing_fee v = v.closing_fee in
+ let start_date v = v.start_date in
+ let end_date v = v.end_date in
+ let sig_ v = v.sig_ in
+ map ~kind:"AggregateTransferFee" make
+ |> mem "wire_fee" Amount.jsont ~enc:wire_fee
+ |> mem "closing_fee" Amount.jsont ~enc:closing_fee
+ |> mem "start_date" Timestamp.jsont ~enc:start_date
+ |> mem "end_date" Timestamp.jsont ~enc:end_date
+ |> mem "sig" MasterWireFee.jsont ~enc:sig_
+ |> finish
+end
+
+module AuditorDenominationKey = struct
+ type t = {
+ denom_pub_h: DenominationHash.t;
+ auditor_sig: ExchangeKeyValidity.t;
+ }
+
+ let jsont =
+ let make denom_pub_h auditor_sig = { denom_pub_h; auditor_sig } in
+ let denom_pub_h v = v.denom_pub_h in
+ let auditor_sig v = v.auditor_sig in
+ map ~kind:"AuditorDenominationKey" make
+ |> mem "denom_pub_h" DenominationHash.jsont ~enc:denom_pub_h
+ |> mem "auditor_sig" ExchangeKeyValidity.jsont ~enc:auditor_sig
+ |> finish
+end
+
+module AuditorKeys = struct
+ type t = {
+ auditor_pub: EddsaPublicKey.t;
+ auditor_url: string;
+ auditor_name: string;
+ denomination_keys: AuditorDenominationKey.t list;
+ }
+
+ let jsont =
+ let make auditor_pub auditor_url auditor_name denomination_keys =
+ { auditor_pub; auditor_url; auditor_name; denomination_keys }
+ in
+ let auditor_pub v = v.auditor_pub in
+ let auditor_url v = v.auditor_url in
+ let auditor_name v = v.auditor_name in
+ let denomination_keys v = v.denomination_keys in
+ map ~kind:"AuditorKeys" make
+ |> mem "auditor_pub" EddsaPublicKey.jsont ~enc:auditor_pub
+ |> mem "auditor_url" Jsont.string ~enc:auditor_url
+ |> mem "auditor_name" Jsont.string ~enc:auditor_name
+ |> mem "denomination_keys"
+ (Jsont.list AuditorDenominationKey.jsont)
+ ~enc:denomination_keys
+ |> finish
+end
+
+module SignKey = struct
+ type t = {
+ key: EddsaPublicKey.t;
+ stamp_start: Timestamp.t;
+ stamp_expire: Timestamp.t;
+ stamp_end: Timestamp.t;
+ master_sig: ExchangeSigningKeyValidity.t;
+ }
+
+ let jsont =
+ let make key stamp_start stamp_expire stamp_end master_sig =
+ { key; stamp_start; stamp_expire; stamp_end; master_sig }
+ in
+ let key v = v.key in
+ let stamp_start v = v.stamp_start in
+ let stamp_expire v = v.stamp_expire in
+ let stamp_end v = v.stamp_end in
+ let master_sig v = v.master_sig in
+ map ~kind:"SignKey" make
+ |> mem "key" EddsaPublicKey.jsont ~enc:key
+ |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+ |> mem "stamp_expire" Timestamp.jsont ~enc:stamp_expire
+ |> mem "stamp_end" Timestamp.jsont ~enc:stamp_end
+ |> mem "master_sig" ExchangeSigningKeyValidity.jsont ~enc:master_sig
+ |> finish
+end
+
+module RecoupDenoms = struct
+ type t = { h_denom_pub: DenominationHash.t }
+
+ let jsont =
+ let make h_denom_pub = { h_denom_pub } in
+ let h_denom_pub v = v.h_denom_pub in
+ map ~kind:"RecoupDenoms" make
+ |> mem "h_denom_pub" DenominationHash.jsont ~enc:h_denom_pub
+ |> finish
+end
+
+module RsaDenom = struct
+ (* correspond to: ({ rsa_pub: RsaPublicKey;} & DenomCommon) *)
+ type t = {
+ rsa_pub: RsaPublicKey.t;
+ master_sig: DenominationKeyValidity.t;
+ stamp_start: Timestamp.t;
+ stamp_expire_withdraw: Timestamp.t;
+ stamp_expire_deposit: Timestamp.t;
+ stamp_expire_legal: Timestamp.t;
+ lost: bool option;
+ }
+
+ let jsont =
+ let make rsa_pub master_sig stamp_start stamp_expire_withdraw
+ stamp_expire_deposit stamp_expire_legal lost =
+ {
+ rsa_pub;
+ master_sig;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ lost;
+ }
+ in
+ let rsa_pub v = v.rsa_pub in
+ let master_sig v = v.master_sig in
+ let stamp_start v = v.stamp_start in
+ let stamp_expire_withdraw v = v.stamp_expire_withdraw in
+ let stamp_expire_deposit v = v.stamp_expire_deposit in
+ let stamp_expire_legal v = v.stamp_expire_legal in
+ let lost v = v.lost in
+ map ~kind:"RsaDenom" make
+ |> mem "rsa_pub" RsaPublicKey.jsont ~enc:rsa_pub
+ |> mem "master_sig" DenominationKeyValidity.jsont ~enc:master_sig
+ |> mem "stamp_start" Timestamp.jsont ~enc:stamp_start
+ |> mem "stamp_expire_withdraw" Timestamp.jsont ~enc:stamp_expire_withdraw
+ |> mem "stamp_expire_deposit" Timestamp.jsont ~enc:stamp_expire_deposit
+ |> mem "stamp_expire_legal" Timestamp.jsont ~enc:stamp_expire_legal
+ |> mem "lost" (Jsont.option Jsont.bool) ~enc:lost
+ |> finish
+end
+
+module RsaDenomGroup = struct
+ type t = {
+ denoms: RsaDenom.t list;
+ value: Amount.t;
+ fee_withdraw: Amount.t;
+ fee_deposit: Amount.t;
+ fee_refresh: Amount.t;
+ fee_refund: Amount.t;
+ }
+
+ let jsont =
+ let make denoms value fee_withdraw fee_deposit fee_refresh fee_refund =
+ { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
+ in
+ let denoms v = v.denoms in
+ let value v = v.value in
+ let fee_withdraw v = v.fee_withdraw in
+ let fee_deposit v = v.fee_deposit in
+ let fee_refresh v = v.fee_refresh in
+ let fee_refund v = v.fee_refund in
+ map ~kind:"RsaDenomGroup" make
+ |> mem "denoms" (Jsont.list RsaDenom.jsont) ~enc:denoms
+ |> mem "value" Amount.jsont ~enc:value
+ |> mem "fee_withdraw" Amount.jsont ~enc:fee_withdraw
+ |> mem "fee_deposit" Amount.jsont ~enc:fee_deposit
+ |> mem "fee_refresh" Amount.jsont ~enc:fee_refresh
+ |> mem "fee_refund" Amount.jsont ~enc:fee_refund
+ |> finish
+end
+
+module DenomGroup = struct
+ type t = Rsa of RsaDenomGroup.t
+
+ let of_rsa v = Rsa v
+
+ let of_cs _v =
+ Jsont.Error.msg Jsont.Meta.none "CSDenomGroup are not supported"
+
+ let of_rsa_age_restricted _v =
+ Jsont.Error.msg Jsont.Meta.none
+ "DenomGroupRsaAgeRestricted are not supported"
+
+ let jsont =
+ let rsa = Case.map "RSA" RsaDenomGroup.jsont ~dec:of_rsa in
+ let cs = Case.map "CS" zero ~dec:of_cs in
+ let rsa_age_restricted =
+ Case.map "RSA+age_restricted" zero ~dec:of_rsa_age_restricted
+ in
+ let cs_age_restricted = Case.map "CS+age_restricted" zero ~dec:of_cs in
+ let enc_case = function Rsa v -> Case.value rsa v in
+ let cases =
+ Case.
+ [ make rsa; make cs; make rsa_age_restricted; make cs_age_restricted ]
+ in
+ map ~kind:"DenomGroup" Fun.id
+ |> case_mem "cipher" Jsont.string ~enc:Fun.id ~enc_case cases
+ |> finish
+end
+
+module AccountLimit = struct
+ type t = {
+ operation_type: Account_operation.t;
+ timeframe: Time.Relative.t;
+ threshold: Amount.t;
+ soft_limit: bool option;
+ }
+
+ let jsont =
+ let make operation_type timeframe threshold soft_limit =
+ { operation_type; timeframe; threshold; soft_limit }
+ in
+ let operation_type v = v.operation_type in
+ let timeframe v = v.timeframe in
+ let threshold v = v.threshold in
+ let soft_limit v = v.soft_limit in
+ map ~kind:"AccountLimit" make
+ |> mem "operation_type" Account_operation.jsont ~enc:operation_type
+ |> mem "timeframe" Time.Relative.jsont ~enc:timeframe
+ |> mem "threshold" Amount.jsont ~enc:threshold
+ |> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit
+ |> finish
+end
+
+module ZeroLimitedOperation = struct
+ type t = { operation_type: Account_operation.t }
+
+ let jsont =
+ let make operation_type = { operation_type } in
+ let operation_type v = v.operation_type in
+ map ~kind:"ZeroLimitedOperation" make
+ |> mem "operation_type" Account_operation.jsont ~enc:operation_type
+ |> finish
+end
+
+module RegexAccountRestriction = struct
+ type t = {
+ payto_regex: string;
+ human_hint: string;
+ (* Map from IETF BCP 47 language tags to localized human hints. *)
+ human_hint_i18n: string option;
+ }
+
+ let jsont =
+ let make payto_regex human_hint human_hint_i18n =
+ { payto_regex; human_hint; human_hint_i18n }
+ in
+ let payto_regex v = v.payto_regex in
+ let human_hint v = v.human_hint in
+ let human_hint_i18n v = v.human_hint_i18n in
+ map ~kind:"RegexAccountRestriction" make
+ |> mem "payto_regex" Jsont.string ~enc:payto_regex
+ |> mem "human_hint" Jsont.string ~enc:human_hint
+ |> opt_mem "human_hint_i18n" Jsont.string ~enc:human_hint_i18n
+ |> finish
+end
+
+module AccountRestriction = struct
+ type t =
+ | Deny
+ | Regex of RegexAccountRestriction.t
+
+ let of_regex v = Regex v
+ let of_deny () = Deny
+
+ let jsont =
+ let regex = Case.map "regex" RegexAccountRestriction.jsont ~dec:of_regex in
+ let deny = Case.map "deny" zero ~dec:of_deny in
+ let enc_case = function
+ | Regex v -> Case.value regex v
+ | Deny -> Case.value deny ()
+ in
+ let cases = Case.[ make regex; make deny ] in
+ map ~kind:"AccountRestriction" Fun.id
+ |> case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases
+ |> finish
+end
+
+module ExchangeWireAccount = struct
+ type t = {
+ payto_uri: string;
+ conversion_url: string option;
+ credit_restrictions: AccountRestriction.t list;
+ debit_restrictions: AccountRestriction.t list;
+ master_sig: MasterWireDetails.t;
+ bank_label: string option;
+ priority: int option;
+ }
+
+ let jsont =
+ let make payto_uri conversion_url credit_restrictions debit_restrictions
+ master_sig bank_label priority =
+ {
+ payto_uri;
+ conversion_url;
+ credit_restrictions;
+ debit_restrictions;
+ master_sig;
+ bank_label;
+ priority;
+ }
+ in
+ let payto_uri v = v.payto_uri in
+ let conversion_url v = v.conversion_url in
+ let credit_restrictions v = v.credit_restrictions in
+ let debit_restrictions v = v.debit_restrictions in
+ let master_sig v = v.master_sig in
+ let bank_label v = v.bank_label in
+ let priority v = v.priority in
+ map ~kind:"ExchangeWireAccount" make
+ |> mem "payto_uri" Jsont.string ~enc:payto_uri
+ |> opt_mem "conversion_url" Jsont.string ~enc:conversion_url
+ |> mem "credit_restrictions"
+ (Jsont.list AccountRestriction.jsont)
+ ~enc:credit_restrictions
+ |> mem "debit_restrictions"
+ (Jsont.list AccountRestriction.jsont)
+ ~enc:debit_restrictions
+ |> mem "master_sig" MasterWireDetails.jsont ~enc:master_sig
+ |> opt_mem "bank_label" Jsont.string ~enc:bank_label
+ |> opt_mem "priority" Jsont.int ~enc:priority
+ |> finish
+end
+
+module ExtensionManifest = struct
+ type t = {
+ critical: bool;
+ version: string;
+ config: Jsont.json option;
+ }
+
+ let jsont =
+ let make critical version config = { critical; version; config } in
+ let critical v = v.critical in
+ let version v = v.version in
+ let config v = v.config in
+ map ~kind:"ExtensionManifest" make
+ |> mem "critical" Jsont.bool ~enc:critical
+ |> mem "version" Jsont.string ~enc:version
+ |> opt_mem "config" (Jsont.any ()) ~enc:config
+ |> finish
+end
+
+module ExchangeKeysResponse = struct
+ module String_map = Map.Make (String)
+
+ type t = {
+ version: string;
+ base_url: string;
+ currency: string;
+ shopping_url: string option;
+ open_banking_gateway: string option;
+ bank_compliance_language: string option;
+ currency_specification: CurrencySpecification.t;
+ tiny_amount: Amount.t option;
+ stefan_abs: Amount.t;
+ stefan_log: Amount.t;
+ stefan_lin: Float.t;
+ asset_type: string;
+ accounts: ExchangeWireAccount.t list;
+ wire_fees: AggregateTransferFee.t list Stdlib.Map.Make(Stdlib.String).t;
+ wads: ExchangePartnerListEntry.t list;
+ rewards_allowed: bool;
+ kyc_enabled: bool;
+ disable_direct_deposit: bool;
+ master_public_key: EddsaPublicKey.t;
+ reserve_closing_delay: Time.Relative.t;
+ wallet_balance_limit_without_kyc: Amount.t list option;
+ hard_limits: AccountLimit.t list;
+ zero_limits: ZeroLimitedOperation.t list;
+ denominations: DenomGroup.t list;
+ (* Compact EdDSA signature (binary-only) over the
+ contatentation of all of the master_sigs (in reverse
+ chronological order by group) in the arrays under
+ "denominations" *)
+ exchange_sig: ExchangeKeySet.t;
+ exchange_pub: EddsaPublicKey.t;
+ recoup: RecoupDenoms.t list;
+ global_fees: GlobalFees.t list;
+ list_issue_date: Timestamp.t;
+ auditors: AuditorKeys.t list;
+ signkeys: SignKey.t list;
+ extensions: ExtensionManifest.t Stdlib.Map.Make(Stdlib.String).t option;
+ (* Signature by the exchange master key of the SHA-256 hash of the
+ normalized JSON-object of field extensions, if it was set.
+ The signature has purpose TALER_SIGNATURE_MASTER_EXTENSIONS. *)
+ extensions_sig: EddsaSignature.t option;
+ }
+
+ let jsont =
+ let make version base_url currency shopping_url open_banking_gateway
+ bank_compliance_language currency_specification tiny_amount stefan_abs
+ stefan_log stefan_lin asset_type accounts wire_fees wads rewards_allowed
+ kyc_enabled disable_direct_deposit master_public_key
+ reserve_closing_delay wallet_balance_limit_without_kyc hard_limits
+ zero_limits denominations exchange_sig exchange_pub recoup global_fees
+ list_issue_date auditors signkeys extensions extensions_sig =
+ {
+ version;
+ base_url;
+ currency;
+ shopping_url;
+ open_banking_gateway;
+ bank_compliance_language;
+ currency_specification;
+ tiny_amount;
+ stefan_abs;
+ stefan_log;
+ stefan_lin;
+ asset_type;
+ accounts;
+ wire_fees;
+ wads;
+ rewards_allowed;
+ kyc_enabled;
+ disable_direct_deposit;
+ master_public_key;
+ reserve_closing_delay;
+ wallet_balance_limit_without_kyc;
+ hard_limits;
+ zero_limits;
+ denominations;
+ exchange_sig;
+ exchange_pub;
+ recoup;
+ global_fees;
+ list_issue_date;
+ auditors;
+ signkeys;
+ extensions;
+ extensions_sig;
+ }
+ in
+
+ let version v = v.version in
+ let base_url v = v.base_url in
+ let currency v = v.currency in
+ let shopping_url v = v.shopping_url in
+ let open_banking_gateway v = v.open_banking_gateway in
+ let bank_compliance_language v = v.bank_compliance_language in
+ let currency_specification v = v.currency_specification in
+ let tiny_amount v = v.tiny_amount in
+ let stefan_abs v = v.stefan_abs in
+ let stefan_log v = v.stefan_log in
+ let stefan_lin v = v.stefan_lin in
+ let asset_type v = v.asset_type in
+ let accounts v = v.accounts in
+ let wire_fees v = v.wire_fees in
+ let wads v = v.wads in
+ let rewards_allowed v = v.rewards_allowed in
+ let kyc_enabled v = v.kyc_enabled in
+ let disable_direct_deposit v = v.disable_direct_deposit in
+ let master_public_key v = v.master_public_key in
+ let reserve_closing_delay v = v.reserve_closing_delay in
+ let wallet_balance_limit_without_kyc v =
+ v.wallet_balance_limit_without_kyc
+ in
+ let hard_limits v = v.hard_limits in
+ let zero_limits v = v.zero_limits in
+ let denominations v = v.denominations in
+ let exchange_sig v = v.exchange_sig in
+ let exchange_pub v = v.exchange_pub in
+ let recoup v = v.recoup in
+ let global_fees v = v.global_fees in
+ let list_issue_date v = v.list_issue_date in
+ let auditors v = v.auditors in
+ let signkeys v = v.signkeys in
+ let extensions v = v.extensions in
+ let extensions_sig v = v.extensions_sig in
+ map ~kind:"ExchangeKeysResponse" make
+ |> mem "version" Jsont.string ~enc:version
+ |> mem "base_url" Jsont.string ~enc:base_url
+ |> mem "currency" Jsont.string ~enc:currency
+ |> opt_mem "shopping_url" Jsont.string ~enc:shopping_url
+ |> opt_mem "open_banking_gateway" Jsont.string ~enc:open_banking_gateway
+ |> opt_mem "bank_compliance_language" Jsont.string
+ ~enc:bank_compliance_language
+ |> mem "currency_specification" CurrencySpecification.jsont
+ ~enc:currency_specification
+ |> opt_mem "tiny_amount" Amount.jsont ~enc:tiny_amount
+ |> mem "stefan_abs" Amount.jsont ~enc:stefan_abs
+ |> mem "stefan_log" Amount.jsont ~enc:stefan_log
+ |> mem "stefan_lin" Jsont.number ~enc:stefan_lin
+ |> mem "asset_type" Jsont.string ~enc:asset_type
+ |> mem "accounts" (Jsont.list ExchangeWireAccount.jsont) ~enc:accounts
+ |> mem "wire_fees"
+ (Jsont.Object.as_string_map (Jsont.list AggregateTransferFee.jsont))
+ ~enc:wire_fees
+ |> mem "wads" (Jsont.list ExchangePartnerListEntry.jsont) ~enc:wads
+ |> mem "rewards_allowed" Jsont.bool ~enc:rewards_allowed
+ |> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled
+ |> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit
+ |> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key
+ |> mem "reserve_closing_delay" Time.Relative.jsont
+ ~enc:reserve_closing_delay
+ |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont)
+ ~enc:wallet_balance_limit_without_kyc
+ |> mem "hard_limits" (Jsont.list AccountLimit.jsont) ~enc:hard_limits
+ |> mem "zero_limits"
+ (Jsont.list ZeroLimitedOperation.jsont)
+ ~enc:zero_limits
+ |> mem "denominations" (Jsont.list DenomGroup.jsont) ~enc:denominations
+ |> mem "exchange_sig" ExchangeKeySet.jsont ~enc:exchange_sig
+ |> mem "exchange_pub" EddsaPublicKey.jsont ~enc:exchange_pub
+ |> mem "recoup" (Jsont.list RecoupDenoms.jsont) ~enc:recoup
+ |> mem "global_fees" (Jsont.list GlobalFees.jsont) ~enc:global_fees
+ |> mem "list_issue_date" Timestamp.jsont ~enc:list_issue_date
+ |> mem "auditors" (Jsont.list AuditorKeys.jsont) ~enc:auditors
+ |> mem "signkeys" (Jsont.list SignKey.jsont) ~enc:signkeys
+ |> opt_mem "extensions"
+ (Jsont.Object.as_string_map ExtensionManifest.jsont)
+ ~enc:extensions
+ |> opt_mem "extensions_sig" EddsaSignature.jsont ~enc:extensions_sig
+ |> finish
+end
diff --git a/.jjconflict-side-1/src/assets.ml b/.jjconflict-side-1/src/assets.ml
new file mode 100644
index 00000000..1826b27e
--- /dev/null
+++ b/.jjconflict-side-1/src/assets.ml
@@ -0,0 +1,164 @@
+(* https://docs.taler.net/design-documents/003-tos-rendering.html
+ https://docs.taler.net/design-documents/003-tos-rendering.html
+
+ must support `text/plain` and `text/markdown` *)
+
+type t =
+ | Terms
+ | Privacy
+
+module Assets_config = struct
+ (* hardcoded config just for static assets *)
+ let default_lang = "en"
+ let default_mimetype = ("text", "plain")
+ let default_extension = ".txt"
+ let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
+ let base_dir = function Terms -> "terms" | Privacy -> "privacy"
+
+ (* TODO this should be in the config like terms_etag *)
+ let terms_legal_version = "0"
+end
+
+let etag k =
+ match k with Terms -> Config.terms_etag | Privacy -> Config.privacy_etag
+
+let supported_lang_arr, supported_ext_arr =
+ let aux t =
+ let prefix = Fpath.v (Assets_config.base_dir t) in
+ let path_l = List.map Fpath.v Assets_crunch.file_list in
+ let path_l = List.filter_map (Fpath.rem_prefix prefix) path_l in
+ let ext_l =
+ path_l |> List.map Fpath.get_ext |> List.sort_uniq String.compare
+ in
+ let lang_l =
+ List.map
+ (fun path ->
+ match Fpath.segs path with
+ | [] -> assert false
+ | [ dir; _file ] -> dir
+ | _l ->
+ Fmt.failwith "invalid folder structure, file `%s` is misplaced"
+ (Fpath.to_string Fpath.(prefix // path)))
+ path_l
+ in
+ let lang_l = List.sort_uniq String.compare lang_l in
+ let etag = (etag t).value in
+ List.iter
+ (fun path ->
+ let etag' = Fpath.to_string (Fpath.rem_ext (Fpath.base path)) in
+ if not @@ String.equal etag etag' then
+ Fmt.failwith
+ "filename of file `%s` does not match configuration ETAG value `%s`"
+ (Fpath.to_string Fpath.(prefix // path))
+ etag)
+ path_l;
+ if List.is_empty lang_l then Fmt.failwith "no language supported";
+ if List.is_empty ext_l then Fmt.failwith "no mimetype supported";
+ if not @@ List.mem Assets_config.default_lang lang_l then
+ Fmt.failwith "default language `%s` files not found"
+ Assets_config.default_lang;
+ if not @@ List.mem ".txt" ext_l then
+ Fmt.failwith "plain text file not found";
+ if not @@ List.mem ".md" ext_l then Fmt.failwith "markdown file not found";
+ List.iter
+ (fun dir ->
+ if String.length dir <> 2 then
+ Fmt.failwith "language directory with invalid name: `%s`" dir)
+ lang_l;
+ if List.length path_l <> List.length ext_l * List.length lang_l then
+ Fmt.failwith
+ "invalid folder structure, all supported language must provide the \
+ same set of file mimetype"
+ else (lang_l, ext_l)
+ in
+ let lang_l, ext_l = aux Terms in
+ let lang_l', ext_l' = aux Privacy in
+ match
+ List.equal String.equal lang_l lang_l'
+ && List.equal String.equal ext_l ext_l'
+ with
+ | false ->
+ Fmt.failwith
+ "invalid folder structure, /terms and /privacy must support the same \
+ set of languages and mimetypes"
+ | true -> (Array.of_list lang_l, Array.of_list ext_l)
+
+module Mimetype = struct
+ type t = string * string
+
+ let pp fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
+
+ let assoc =
+ List.filter
+ (fun (_mime, ext) -> Array.mem ext supported_ext_arr)
+ [
+ (("text", "plain"), ".txt");
+ (("text", "markdown"), ".md");
+ (("text", "html"), ".html");
+ (("text", "html"), ".htm");
+ (("application", "pdf"), ".pdf");
+ (("image", "jpeg"), ".jpg");
+ (("image", "jpeg"), ".jpeg");
+ (("image", "png"), ".png");
+ (("image", "gif"), ".gif");
+ ]
+
+ let arr =
+ let all_supported, all_supported_ext = List.split assoc in
+ match
+ Array.find_opt
+ (fun ext -> not @@ List.exists (( = ) ext) all_supported_ext)
+ supported_ext_arr
+ with
+ | Some ext -> Fmt.failwith "extension `%s` unsupported" ext
+ | None -> Array.of_list all_supported
+
+ let default =
+ match
+ List.mem
+ (Assets_config.default_mimetype, Assets_config.default_extension)
+ assoc
+ with
+ | false ->
+ Fmt.failwith "default content type `%a` not supported" pp
+ Assets_config.default_mimetype
+ | true -> Assets_config.default_mimetype
+
+ let of_cohttp = function
+ | Cohttp.Accept.MediaType (m, m_sub) ->
+ Array.find_opt (( = ) (m, m_sub)) arr
+ | AnyMediaSubtype m -> Array.find_opt (fun (m', _) -> String.equal m m') arr
+ | AnyMedia -> Some default
+
+ let to_extension_exn t =
+ match List.assoc_opt t assoc with
+ | None -> Fmt.failwith "Mimetype.to_extension failure: `%a` unknown" pp t
+ | Some ext -> ext
+end
+
+module Language = struct
+ type t = string
+
+ let arr = supported_lang_arr
+ let default = Assets_config.default_lang
+
+ let of_cohttp = function
+ | Cohttp.Accept.AnyLanguage -> Some default
+ | Language language_range -> (
+ (* ignore language subtags (e.g. "en-US" -> "en") *)
+ match language_range with
+ | [] -> assert false
+ | lang :: _ when Array.mem lang supported_lang_arr -> Some lang
+ | _ -> None)
+end
+
+(* ! lang and mime must be supported *)
+let get_content ~lang ~mime t =
+ let ext = Mimetype.to_extension_exn mime in
+ let path =
+ Fpath.to_string
+ Fpath.((v (Assets_config.base_dir t) / lang / (etag t).value) + ext)
+ in
+ match Assets_crunch.read path with
+ | None -> Fmt.failwith "static file not found: `%s`" path
+ | Some data -> data
diff --git a/.jjconflict-side-1/src/b32.ml b/.jjconflict-side-1/src/b32.ml
new file mode 100644
index 00000000..6bd06400
--- /dev/null
+++ b/.jjconflict-side-1/src/b32.ml
@@ -0,0 +1,38 @@
+(* Crockford's variant of Base32
+ http://www.crockford.com/wrmg/base32.html
+ except that:
+ - 'U' is not excluded but also decodes to 'V'
+ - '-' is not allowed
+ - checksum is not allowed *)
+
+(* 'I' 'L' 'O' 'U' excluded
+ no '=' padding in encoded string *)
+type t = string
+
+let alphabet = Base32.make_alphabet "0123456789ABCDEFGHJKMNPQRSTVWXYZ"
+
+let encode s =
+ let s = Base32.encode_string ~alphabet s in
+ (* remove '=' padding *)
+ match String.index_opt s '=' with
+ | None -> s
+ | Some i -> String.sub s 0 i
+
+let decode s =
+ let s =
+ String.map
+ (fun c ->
+ match Char.uppercase_ascii c with
+ | 'O' -> '0'
+ | 'I' | 'L' -> '1'
+ | 'U' -> 'V'
+ | c -> c)
+ s
+ in
+ (* restore padding for base32 lib *)
+ let n = 8 - (String.length s mod 8) in
+ let pad = String.make n '=' in
+ let s = s ^ pad in
+ match Base32.decode ~alphabet ~off:0 ~len:(String.length s) s with
+ | Error (`Msg e) -> Error e
+ | Ok v -> Ok v
diff --git a/.jjconflict-side-1/src/config.ml b/.jjconflict-side-1/src/config.ml
new file mode 100644
index 00000000..3ccc104b
--- /dev/null
+++ b/.jjconflict-side-1/src/config.ml
@@ -0,0 +1,202 @@
+open Parse_config
+
+let config_filename = "mte.conf"
+let secrets_dir = Fpath.v "secrets"
+
+let config_data =
+ match Assets_crunch.read config_filename with
+ | None -> fail "static file not found: `%s`" config_filename
+ | Some data ->
+ let v = Config_section.parse data in
+ v
+
+module Exchange = struct
+ let get_opt field = get_opt config_data ~section:"exchange" ~field
+ let get field = get config_data ~section:"exchange" ~field
+
+ (* - *)
+ let currency = (* todo: constraint on currency string *) get "currency"
+ let currency_round_unit = get "currency_round_unit" |> amount
+ let db = get "db" |> const_value "postgres"
+ let attribute_encryption_key = get "attribute_encryption_key"
+ let port = get "port" |> int
+ let bind_to = get "bind_to"
+ let master_public_key = get "master_public_key" |> ed25519
+
+ (* TODO Defaults to 0.0 if not specified. *)
+ let stefan_abs = get "stefan_abs" |> amount
+ let stefan_log = get "stefan_log" |> amount
+
+ let stefan_lin =
+ get_opt "stefan_lin" |> Option.map float |> Option.value ~default:0.0
+
+ let aggregator_idle_sleep_interval =
+ get "aggregator_idle_sleep_interval" |> duration
+
+ let closer_idle_sleep_interval = get "closer_idle_sleep_interval" |> duration
+
+ let transfer_idle_sleep_interval =
+ get "transfer_idle_sleep_interval" |> duration
+
+ let wirewatch_idle_sleep_interval =
+ get "wirewatch_idle_sleep_interval" |> duration
+
+ let signkey_legal_duration = get "signkey_legal_duration" |> duration
+ let max_keys_caching = get "max_keys_caching" |> duration
+ let enable_kyc = get "enable_kyc" |> yes_no
+ let terms_etag = get "terms_etag" |> etag
+ let privacy_etag = get "privacy_etag" |> etag
+ let base_url = get "base_url"
+ let shopping_url = get_opt "shopping_url"
+ let open_banking_gateway_url = get_opt "open_banking_gateway_url"
+ let bank_compliance_language = get_opt "bank_compliance_language"
+ let aml_spa_dialect = get_opt "aml_spa_dialect"
+ let toplevel_redirect_url = get_opt "toplevel_redirect_url"
+ let tiny_amount = get_opt "tiny_amount" |> Option.map amount
+
+ (* not implemented or not relevant to MTE:
+ let max_requests = get "max_requests" |> int
+ aggregator_shard_size
+ serve
+ unixpath
+ unixpath_mode
+ terms_dir
+ privacy_dir *)
+end
+
+module Exchangedb = struct
+ let get field = get config_data ~section:"exchangedb" ~field
+
+ (* - *)
+ let idle_reserve_expiration_time =
+ get "idle_reserve_expiration_time" |> duration
+
+ let legal_reserve_expiration_time =
+ get "legal_reserve_expiration_time" |> duration
+
+ let aggregator_shift = get "aggregator_shift" |> duration
+ let max_aml_program_runtime = get "max_aml_program_runtime" |> duration
+ let default_purse_limit = get "default_purse_limit" |> int
+end
+
+module Exchangedb_postgres = struct
+ let config =
+ get config_data ~section:"exchangedb-postgres" ~field:"config" |> uri
+end
+
+module Currency = struct
+ type t = {
+ enabled: [ `YES | `NO ];
+ code: string;
+ name: string;
+ fractional_input_digits: int;
+ fractional_normal_digits: int;
+ fractional_trailing_zero_digits: int;
+ alt_unit_names: (int * string) list;
+ }
+
+ let currency_sections =
+ List.filter
+ (fun v -> String.starts_with ~prefix:"currency-" v.header)
+ config_data
+
+ let parse_currency section =
+ let get field = get config_data ~section:section.header ~field in
+ {
+ enabled= get "enabled" |> yes_no;
+ code= get "code";
+ name= get "name";
+ fractional_input_digits= get "fractional_input_digits" |> int;
+ fractional_normal_digits= get "fractional_normal_digits" |> int;
+ fractional_trailing_zero_digits=
+ get "fractional_trailing_zero_digits" |> int;
+ alt_unit_names=
+ get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap;
+ }
+
+ let all_currencies = List.map parse_currency currency_sections
+
+ (* I think the exchange only handle one currency *)
+ let v =
+ match
+ List.find_opt (fun v -> v.code = Exchange.currency) all_currencies
+ with
+ | None ->
+ fail "section `[currency-%s]` not found, currency `%s` is not defined"
+ Exchange.currency Exchange.currency
+ | Some v -> (
+ match v.enabled = `YES with
+ | false -> fail "currency `%s` is not enabled" Exchange.currency
+ | true -> v)
+end
+
+module Coin = struct
+ type t = {
+ section_name: string;
+ value: Amount.t;
+ duration_withdraw: Time.Relative.t;
+ duration_spend: Time.Relative.t;
+ duration_legal: Time.Relative.t;
+ fee_withdraw: Amount.t;
+ fee_deposit: Amount.t;
+ fee_refresh: Amount.t;
+ fee_refund: Amount.t;
+ cipher: [ (* `CS |*) `RSA ];
+ rsa_keysize: int; (* : int option (only if `RSA) *)
+ age_restricted: [ (*`YES|*) `NO ];
+ }
+
+ let coin_sections =
+ List.filter
+ (fun v ->
+ (* note: here its a '_' not '-' *)
+ String.starts_with ~prefix:"coin_" v.header)
+ config_data
+
+ let parse_coin section =
+ let get field = get config_data ~section:section.header ~field in
+ let section_name =
+ String.sub section.header 5 (String.length section.header - 5)
+ in
+ {
+ section_name;
+ value= get "value" |> amount;
+ duration_withdraw= get "duration_withdraw" |> duration;
+ duration_spend= get "duration_spend" |> duration;
+ duration_legal= get "duration_legal" |> duration;
+ fee_withdraw= get "fee_withdraw" |> amount;
+ fee_deposit= get "fee_deposit" |> amount;
+ fee_refresh= get "fee_refresh" |> amount;
+ fee_refund= get "fee_refund" |> amount;
+ cipher= (get "cipher" |> const_value "RSA" |> fun _s -> `RSA);
+ rsa_keysize= get "rsa_keysize" |> int;
+ age_restricted=
+ ( get "age_restricted" |> yes_no |> function
+ | `NO -> `NO
+ | `YES -> fail "`age_restricted = YES` is not supported" );
+ }
+
+ let all_coins = List.map parse_coin coin_sections
+end
+
+module Exchange_secmod_rsa = struct
+ let get field =
+ let section = "taler-exchange-secmod-" ^ "rsa" in
+ get config_data ~section ~field
+
+ let lookahead_sign = get "lookahead_sign" |> duration
+ let overlap_duration = get "overlap_duration" |> duration
+ (* not relevant: sm_priv_key key_dir unixpath *)
+end
+
+module Exchange_secmod_eddsa = struct
+ let get field =
+ let section = "taler-exchange-secmod-" ^ "eddsa" in
+ get config_data ~section ~field
+
+ let lookahead_sign = get "lookahead_sign" |> duration
+ let overlap_duration = get "overlap_duration" |> duration
+end
+
+(* -- *)
+include Exchange
diff --git a/.jjconflict-side-1/src/crypto.ml b/.jjconflict-side-1/src/crypto.ml
new file mode 100644
index 00000000..bf437fce
--- /dev/null
+++ b/.jjconflict-side-1/src/crypto.ml
@@ -0,0 +1,300 @@
+open Syntax
+
+module Binary_format_rsa = struct
+ (* TODO tests:
+ - need to strip leading zeros?
+ - endianess ok? *)
+ (* RSA public key binary format
+ https://www.gnupg.org/documentation/manuals/gcrypt/MPI-formats.html
+ := { uint16_be: n size; uint16_be: e size; n; e}
+
+ integer in big-endian format (MSB first)
+ leading zeroes are stripped unless they are required to keep a value positive
+ no 0-termination *)
+
+ let rev_string len s = String.init len (fun i -> s.[len - 1 - i])
+
+ (* we reverse bytes because Z.of_bits reads bytes in little endian *)
+ let z_of_bits_be src pos len =
+ String.sub src pos len |> rev_string len |> Z.of_bits
+
+ let z_to_bits_be z =
+ let bits = Z.to_bits z in
+ rev_string (String.length bits) bits
+
+ let z_array_to_octets (arr : Z.t array) =
+ let nb = Array.length arr in
+ let bits_arr = Array.map z_to_bits_be arr in
+ let len_arr = Array.map String.length bits_arr in
+ let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
+ let b = Bytes.make len '\x00' in
+ let pos = ref 0 in
+ Array.iter
+ (fun len ->
+ Bytes.set_uint16_be b !pos len;
+ pos := !pos + 2)
+ len_arr;
+ Array.iteri
+ (fun i bits ->
+ let len = len_arr.(i) in
+ Bytes.blit_string bits 0 b !pos len;
+ pos := !pos + len)
+ bits_arr;
+ Bytes.unsafe_to_string b
+
+ let check = function
+ | false -> Error "rsa of_octets error, invalid data"
+ | true -> Ok ()
+
+ let z_array_of_octets ~nb s =
+ let s_len = String.length s in
+ let* () = check (s_len > 2 * nb) in
+ let pos = ref 0 in
+ let len_arr =
+ Array.init nb (fun _i ->
+ let len = String.get_uint16_be s !pos in
+ pos := !pos + 2;
+ len)
+ in
+ let* () =
+ let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
+ check (s_len = len)
+ in
+ let z_arr =
+ Array.init nb (fun i ->
+ let len = len_arr.(i) in
+ let z = z_of_bits_be s !pos len in
+ pos := !pos + len;
+ z)
+ in
+ Ok z_arr
+
+ let pub_to_octets ({ n; e } : Mirage_crypto_pk.Rsa.pub) =
+ z_array_to_octets [| n; e |]
+
+ let pub_of_octets s =
+ let* arr = z_array_of_octets ~nb:2 s in
+ match arr with
+ | [| n; e |] ->
+ let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg in
+ pub
+ | _ -> assert false
+
+ let priv_to_octets ({ e; d; n; p; q; dp; dq; q' } : Mirage_crypto_pk.Rsa.priv)
+ =
+ z_array_to_octets [| e; d; n; p; q; dp; dq; q' |]
+
+ let priv_of_octets s =
+ let* arr = z_array_of_octets ~nb:8 s in
+ match arr with
+ | [| e; d; n; p; q; dp; dq; q' |] ->
+ let+ priv =
+ Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_err_msg
+ in
+ priv
+ | _ -> assert false
+end
+
+(* TODO key format
+ - check what is the exact format in GNUNET
+ - endianess issue? *)
+module EddsaPublicKey = struct
+ (* EdDSA and ECDHE public keys always point on Curve25519
+ and represented using the standard 256 bits Ed25519 compact format,
+ converted to Crockford Base32. *)
+ open Mirage_crypto_ec.Ed25519
+
+ type t = pub
+
+ let to_octets t = pub_to_octets t
+
+ let of_octets t =
+ pub_of_octets t |> function
+ | Error e -> Fmt.error "%a" Mirage_crypto_ec.pp_error e
+ | Ok v -> Ok v
+
+ let bin =
+ let of_octets_exn t = of_octets t |> Result.get_ok in
+ Bin.map (Bin.bytes 32) of_octets_exn to_octets
+
+ let of_b32 s =
+ let* octets = B32.decode s in
+ let* pub = of_octets octets in
+ Ok pub
+
+ let to_b32 t = B32.encode (to_octets t)
+ let jsont = Jsont.of_of_string ~kind:"EddsaPublicKey" of_b32 ~enc:to_b32
+
+ let caqti =
+ Caqti_type.custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> of_octets v)
+ Caqti_type.octets
+end
+
+module EddsaPrivateKey = struct
+ (* EdDSA and ECDHE public keys always point on Curve25519
+ and represented using the standard 256 bits Ed25519 compact format,
+ converted to Crockford Base32. *)
+ open Mirage_crypto_ec.Ed25519
+
+ type t = priv
+
+ let pub_of_priv = pub_of_priv
+ let to_octets t = priv_to_octets t
+
+ let of_octets t =
+ priv_of_octets t |> function
+ | Error err ->
+ let err = Fmt.str "%a" Mirage_crypto_ec.pp_error err in
+ Error err
+ | Ok v -> Ok v
+
+ let bin =
+ let of_octets_exn t = of_octets t |> Result.get_ok in
+ Bin.map (Bin.bytes 32) of_octets_exn to_octets
+
+ let jsont =
+ let of_b32 s =
+ let* octets = B32.decode s in
+ of_octets octets
+ in
+ let to_b32 t = B32.encode (to_octets t) in
+ Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32
+end
+
+module EddsaSignature : sig
+ type t
+
+ val sign : key:EddsaPrivateKey.t -> string -> t
+
+ (* Ok () on verification success *)
+ val verify : key:EddsaPublicKey.t -> t -> msg:string -> (unit, string) result
+ val to_octets : t -> string
+ val of_octets : string -> (t, string) result
+ val jsont : t Jsont.t
+ val bin : t Bin.t
+ val caqti : t Caqti_type.t
+end = struct
+ (* TODO key format
+ endianess issue? *)
+ (* transmitted as 64-bytes base32
+ binary-encoded objects with just the R and S values *)
+ type t = string
+
+ (* mirage_crypto: "The result is the concatenation of r and s, as specified in RFC 8032." *)
+ let sign ~key s = Mirage_crypto_ec.Ed25519.sign ~key s
+
+ let verify ~key s ~msg =
+ let b = Mirage_crypto_ec.Ed25519.verify ~key s ~msg in
+ match b with
+ | false -> Error "signature verification failure: invalid signature"
+ | true -> Ok ()
+
+ let to_octets t = t
+
+ let of_octets v =
+ match String.length v = 64 with
+ | false ->
+ Fmt.error "EddsaSignature.of_octets failure: data is not 64 bytes."
+ | true -> Ok v
+
+ let bin =
+ let of_octets_exn t = of_octets t |> Result.get_ok in
+ Bin.map (Bin.bytes 64) of_octets_exn to_octets
+
+ let check_size t =
+ match String.length t = 64 with
+ | false -> Error "EddsaSignature: invalid string length"
+ | true -> Ok ()
+
+ let jsont =
+ let of_b32 s =
+ let* t = B32.decode s in
+ let+ () = check_size t in
+ t
+ in
+ let to_b32 = B32.encode in
+ Jsont.of_of_string ~kind:"EddsaSignature" of_b32 ~enc:to_b32
+
+ let caqti =
+ Caqti_type.custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun s -> of_octets s)
+ Caqti_type.octets
+end
+
+module RsaPublicKey = struct
+ open Mirage_crypto_pk
+
+ type t = Rsa.pub
+
+ let to_octets = Binary_format_rsa.pub_to_octets
+ let of_octets = Binary_format_rsa.pub_of_octets
+
+ let jsont =
+ let of_b32 s =
+ let* s = B32.decode s in
+ let+ v = of_octets s in
+ v
+ in
+ let to_b32 t = B32.encode (to_octets t) in
+ Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
+
+ let caqti : t Caqti_type.t =
+ Caqti_type.custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> of_octets v)
+ Caqti_type.octets
+end
+
+module RsaPrivateKey = struct
+ open Mirage_crypto_pk.Rsa
+
+ type t = priv
+
+ let generate ~bits () =
+ let priv = generate ~bits () in
+ let pub = pub_of_priv priv in
+ (priv, pub)
+
+ let pub_of_priv = pub_of_priv
+ let of_octets = Binary_format_rsa.priv_of_octets
+ let to_octets = Binary_format_rsa.priv_to_octets
+
+ let jsont =
+ let of_b32 s =
+ let* s = B32.decode s in
+ let+ v = of_octets s in
+ v
+ in
+ let to_b32 t = B32.encode (to_octets t) in
+ Jsont.of_of_string ~kind:"RsaPrivateKey" of_b32 ~enc:to_b32
+end
+
+module RsaSignature : sig
+ type t
+
+ val sign : key:Mirage_crypto_pk.Rsa.priv -> string -> t
+ val jsont : t Jsont.t
+end = struct
+ type t = string
+
+ (* TODO rsa sign *)
+ let sign ~key s =
+ Mirage_crypto_pk.Rsa.decrypt ~crt_hardening:true ~mask:`Yes ~key s
+
+ let jsont =
+ let of_b32 s = B32.decode s in
+ let to_b32 t = B32.encode t in
+ Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
+end
+
+(* some type aliases, just for prettier .mli *)
+type eddsa_priv = EddsaPrivateKey.t
+type eddsa_pub = EddsaPublicKey.t
+type eddsa_sig = EddsaSignature.t
+type rsa_priv = RsaPrivateKey.t
+type rsa_pub = RsaPublicKey.t
+type rsa_sig = RsaSignature.t
+type denomination_hash = Hash.DenominationHash.t
diff --git a/.jjconflict-side-1/src/data_file.ml b/.jjconflict-side-1/src/data_file.ml
new file mode 100644
index 00000000..9fa34674
--- /dev/null
+++ b/.jjconflict-side-1/src/data_file.ml
@@ -0,0 +1,35 @@
+open Bos.OS
+open Syntax
+open Crypto
+
+let read fname =
+ let* b = File.exists fname |> Syntax.unwrap_err_msg in
+ match b with
+ | false -> Ok None
+ | true ->
+ let+ content = File.read fname |> Syntax.unwrap_err_msg in
+ Some content
+
+let write_eddsa fname priv =
+ EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let write_rsa fname priv =
+ RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+
+let read_eddsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ EddsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
+
+let read_rsa fname =
+ let* opt = read fname in
+ match opt with
+ | None -> Ok None
+ | Some data -> (
+ RsaPrivateKey.of_octets data |> function
+ | Error e -> Error e
+ | Ok v -> Ok (Some v))
diff --git a/.jjconflict-side-1/src/denom_data.ml b/.jjconflict-side-1/src/denom_data.ml
new file mode 100644
index 00000000..7d94367d
--- /dev/null
+++ b/.jjconflict-side-1/src/denom_data.ml
@@ -0,0 +1,18 @@
+open Crypto
+
+type t = {
+ pub: rsa_pub;
+ value: Amount.t;
+ stamp_start: Timestamp.t;
+ stamp_expire_withdraw: Timestamp.t;
+ stamp_expire_deposit: Timestamp.t;
+ stamp_expire_legal: Timestamp.t;
+ fee_withdraw: Amount.t;
+ fee_deposit: Amount.t;
+ fee_refresh: Amount.t;
+ fee_refund: Amount.t;
+ age_mask: int;
+ h_pub: denomination_hash;
+ master_sig: Signatures.DenominationKeyValidity.t option;
+ revoked_sig: Signatures.MasterDenominationKeyRevocation.t option;
+}
diff --git a/.jjconflict-side-1/src/devices.ml b/.jjconflict-side-1/src/devices.ml
new file mode 100644
index 00000000..7da26428
--- /dev/null
+++ b/.jjconflict-side-1/src/devices.ml
@@ -0,0 +1,26 @@
+type env = {
+ caqti_switch: Caqti_miou.Switch.t;
+ db_uri: Uri.t;
+}
+
+let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
+ let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
+ Vif.Device.v ~name:"db_connection" ~finally []
+ @@ fun { caqti_switch; db_uri } ->
+ match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
+ | Error err ->
+ Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
+ | Ok conn -> (
+ match Pg.preflight conn with
+ | Error err ->
+ Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
+ | Ok () ->
+ Logs.info (fun m -> m "database connection initialized");
+ conn)
+
+let secmod =
+ let finally _key = () in
+ Vif.Device.v ~name:"secmod" ~finally [ Vif.Device.value db_connection ]
+ @@ fun (module Conn : Pg.CONN) (_env : env) ->
+ let sm : (module Secmod.S) = (module Secmod.Make (Conn)) in
+ sm
diff --git a/.jjconflict-side-1/src/dune b/.jjconflict-side-1/src/dune
new file mode 100644
index 00000000..a9322eed
--- /dev/null
+++ b/.jjconflict-side-1/src/dune
@@ -0,0 +1,44 @@
+(executable
+ (public_name mte)
+ (name mte)
+ (modules mte)
+ (libraries mte))
+
+(library
+ (name mte)
+ (wrapped false)
+ (modules :standard \ mte b32)
+ (libraries
+ b32
+ ;
+ caqti
+ caqti-miou
+ caqti-miou.unix
+ caqti-driver-pgx
+ bin
+ mirage-crypto
+ digestif
+ duration
+ vif
+ fmt
+ jsont
+ cohttp
+ ptime
+ logs
+ logs.fmt
+ logs.threaded
+ fmt.tty))
+
+(library ; crockford base32
+ (name b32)
+ (modules b32)
+ (libraries base32))
+
+(rule
+ (target assets_crunch.ml)
+ (deps
+ (source_tree ../assets))
+ (action
+ (with-stdout-to
+ %{null}
+ (run ocaml-crunch -m plain ../assets -o %{target}))))
diff --git a/.jjconflict-side-1/src/hash.ml b/.jjconflict-side-1/src/hash.ml
new file mode 100644
index 00000000..0da809df
--- /dev/null
+++ b/.jjconflict-side-1/src/hash.ml
@@ -0,0 +1,104 @@
+(* TODO use SHA512.of_raw_string_opt *)
+open Digestif
+
+module type S = sig
+ type t
+
+ val bin : t Bin.t
+ val caqti : t Caqti_type.t
+ val jsont : t Jsont.t
+ val hash : string -> t
+ val of_octets : string -> t
+ val to_octets : t -> string
+ val of_b32 : B32.t -> (t, string) result
+end
+
+module H32 = struct
+ type t = SHA256.t
+
+ let hash s = SHA256.(digest_string s)
+
+ let of_octets s =
+ match SHA256.of_raw_string_opt s with
+ | None -> Fmt.failwith "H32.of_octets failure: data is not 32 bytes"
+ | Some t -> t
+
+ let to_octets = SHA256.to_raw_string
+ let of_b32 s = Result.map of_octets (B32.decode s)
+
+ let bin =
+ let open Bin in
+ map (bytes 32) of_octets to_octets
+
+ (* hashes are not b32 encoded in the database *)
+ let caqti =
+ let open Caqti_type in
+ custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> Ok (of_octets v))
+ octets
+
+ let jsont =
+ let enc v = B32.encode (to_octets v) in
+ Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc
+end
+
+module H64 = struct
+ type t = SHA512.t
+
+ let hash s = SHA512.(digest_string s)
+
+ let of_octets s =
+ match SHA512.of_raw_string_opt s with
+ | None -> Fmt.failwith "H64.of_octets failure: data is not 64 bytes"
+ | Some t -> t
+
+ let to_octets = SHA512.to_raw_string
+ let of_b32 s = Result.map of_octets (B32.decode s)
+
+ let bin =
+ let open Bin in
+ map (bytes 64) of_octets to_octets
+
+ (* hashes are not b32 encoded in the database *)
+ let caqti =
+ let open Caqti_type in
+ custom
+ ~encode:(fun v -> Ok (to_octets v))
+ ~decode:(fun v -> Ok (of_octets v))
+ octets
+
+ let jsont =
+ let enc v = B32.encode (to_octets v) in
+ Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc
+end
+
+(* C-terminated strings
+ some strings need to be hashed with a '\0' termination char *)
+module Cstring = struct
+ module H32 = struct
+ include H32
+
+ let hash s = hash (s ^ "\x00")
+ end
+
+ module H64 = struct
+ include H64
+
+ let hash s = hash (s ^ "\x00")
+ end
+end
+
+(* TODO
+ check which hash algorithm to use for each hash type *)
+module FullPaytoHash : S = H32
+module NormalizedPaytoHash : S = H32
+module DenominationHash : S = H64
+module PrivateContractHash : S = H64
+module ExtensionsPolicyHash : S = H64
+module MerchantWireHash : S = H64
+module AgeCommitmentHash : S = H64
+module BlindedCoinHash : S = H64
+module CoinPubHash : S = H64
+module OutputCommitmentHash : S = H64
+module HashPlanchetsP : S = H64
diff --git a/.jjconflict-side-1/src/headers.ml b/.jjconflict-side-1/src/headers.ml
new file mode 100644
index 00000000..fb2070bc
--- /dev/null
+++ b/.jjconflict-side-1/src/headers.ml
@@ -0,0 +1,48 @@
+(* TODO header
+ Cohttp -> Http *)
+
+let accept_header_value =
+ let pp_list pp_item item = Fmt.list ~sep:(Fmt.any ", ") pp_item item in
+ Fmt.str "%a" (pp_list Assets.Mimetype.pp) Assets.Mimetype.all_supported
+
+let avail_languages_header_value =
+ let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item in
+ let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
+ s
+
+(* TODO Cohttp raises on invalid *)
+let select_mimetype headers =
+ let opt = Vif.Headers.get headers "accept" in
+ Cohttp.Accept.media_ranges opt
+ |> Cohttp.Accept.qsort
+ |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
+ |> function
+ | None -> Assets.default_mimetype
+ | Some mime -> mime
+
+let select_language headers =
+ let opt = Vif.Headers.get headers "accept-language" in
+ Cohttp.Accept.languages opt
+ |> Cohttp.Accept.qsort
+ |> List.map snd
+ |> List.find_map Assets.Language.of_cohttp_language
+ |> function
+ | None -> Assets.default_lang
+ | Some lang -> lang
+
+let select_encoding headers =
+ let opt = Vif.Headers.get headers "accept-encoding" in
+ Cohttp.Accept.encodings opt
+ |> Cohttp.Accept.qsort
+ |> List.map snd
+ |> List.find_map (function
+ | Cohttp.Accept.Identity -> Some `Identity
+ | Deflate -> Some `DEFLATE
+ | Gzip -> Some `Gzip
+ | AnyEncoding -> Some Assets.default_encoding
+ | Encoding _ | Compress -> (* unsupported *) None)
+ |> function
+ | None -> None
+ | Some `Identity -> None
+ | Some `DEFLATE -> Some `DEFLATE
+ | Some `Gzip -> Some `Gzip
diff --git a/.jjconflict-side-1/src/headers_lib.ml b/.jjconflict-side-1/src/headers_lib.ml
new file mode 100644
index 00000000..e76a589a
--- /dev/null
+++ b/.jjconflict-side-1/src/headers_lib.ml
@@ -0,0 +1,69 @@
+module Etag = struct
+ (* https://httpwg.org/specs/rfc9110.html#field.etag *)
+
+ type t = {
+ weak: bool;
+ value: string;
+ }
+
+ let pp ppf { weak; value } =
+ match weak with
+ | false -> Fmt.pf ppf {|"%s"|} value
+ | true -> Fmt.pf ppf {|W/"%s"|} value
+
+ let to_field_string t = Fmt.str "%a" pp t
+
+ let angstrom =
+ let open Angstrom in
+ let is_valid_char c =
+ let n = Char.code c in
+ (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF)
+ in
+ let quoted_string = char '"' *> take_while is_valid_char <* char '"' in
+ lift2
+ (fun weak value -> { weak; value })
+ (option false (string "W/" *> return true))
+ quoted_string
+
+ let parse s =
+ match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+ | Error _e -> Fmt.error "invalid etag: `%s`" s
+ | Ok v -> Ok v
+end
+
+module If_none_match = struct
+ type t =
+ | Any
+ | List of Etag.t list
+
+ let pp ppf = function
+ | Any -> Fmt.pf ppf {|*|}
+ | List l -> Fmt.pf ppf {|%a|} (Fmt.list ~sep:(Fmt.any ", ") Etag.pp) l
+
+ let angstrom =
+ let open Angstrom in
+ let ows = skip_while (function ' ' | '\t' -> true | _ -> false) in
+ let comma = ows *> char ',' *> ows in
+ (* A recipient MUST parse and ignore a reasonable number of empty list elements *)
+ let etag_opt = Etag.angstrom >>| Option.some <|> return None in
+ let etags =
+ etag_opt >>= fun hd ->
+ many (comma *> etag_opt) >>= fun tl ->
+ let l = List.filter_map Fun.id (hd :: tl) in
+ match l with [] -> fail "empty etag list" | l -> return (List l)
+ in
+ let any = char '*' *> return Any in
+ any <|> etags
+
+ let parse s =
+ match Angstrom.parse_string ~consume:Angstrom.Consume.All angstrom s with
+ | Error _e -> Fmt.error "invalid if-none-match field: `%s`" s
+ | Ok v -> Ok v
+
+ let evaluate etag t =
+ match t with
+ | Any -> false
+ | List l ->
+ not
+ @@ List.exists (fun e -> String.equal etag.Etag.value e.Etag.value) l
+end
diff --git a/.jjconflict-side-1/src/http_information.ml b/.jjconflict-side-1/src/http_information.ml
new file mode 100644
index 00000000..79ac240e
--- /dev/null
+++ b/.jjconflict-side-1/src/http_information.ml
@@ -0,0 +1,279 @@
+open Syntax
+open Api
+module String_map = Stdlib.Map.Make (Stdlib.String)
+
+(* TODO mirage-crypto
+ is this ok?
+ maybe don't use the same RNG-initialization as the one used to generate keys *)
+let seed req _server _env =
+ Logs.info (fun m -> m "GET /seed");
+ (* RNG is initialized by Vif.run *)
+ let s = Mirage_crypto_rng.generate 64 in
+ let open Vif.Response in
+ let open Syntax in
+ let* () = add ~field:"content-type" "application/octet-stream" in
+ let* () = with_string req s in
+ respond `OK
+
+let config req _server _env =
+ Logs.info (fun m -> m "GET /config");
+ let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in
+ Respond_util.respond_with_ok_json s req
+
+(* TODO
+ for now we only have one item in each "denom group"
+ change this once we have denom/signkey rotation *)
+let denomgroup_of_denomdata
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask= _;
+ h_pub= _;
+ master_sig;
+ revoked_sig= _;
+ } =
+ let master_sig = match master_sig with None -> assert false | Some v -> v in
+ let denoms =
+ [
+ RsaDenom.
+ {
+ rsa_pub= pub;
+ master_sig;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ lost= None;
+ };
+ ]
+ in
+ DenomGroup.Rsa
+ RsaDenomGroup.
+ { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
+
+let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date =
+ let version = Api.protocol_version in
+ let base_url = Config.base_url in
+ let currency = Config.currency in
+ let shopping_url = Config.shopping_url in
+ let open_banking_gateway = Config.open_banking_gateway_url in
+ let bank_compliance_language = Config.bank_compliance_language in
+ let currency_specification =
+ let v = Config.Currency.v in
+ let alt_unit_names =
+ Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+ in
+ CurrencySpecification.
+ {
+ name= v.name;
+ num_fractional_input_digits= v.fractional_input_digits;
+ num_fractional_normal_digits= v.fractional_normal_digits;
+ num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits;
+ alt_unit_names;
+ common_amounts= [];
+ }
+ in
+ let tiny_amount = Config.tiny_amount in
+ let stefan_abs = Config.stefan_abs in
+ let stefan_log = Config.stefan_log in
+ let stefan_lin = Config.stefan_lin in
+ (* todo asset_type
+ Type of the asset. "fiat", "crypto", "regional" or "stock". *)
+ let asset_type = "xxx" in
+ let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in
+ let* wire_fees =
+ (* todo
+ where does wire_methods comes from? *)
+ let wire_method = "xxx" in
+ let+ wire_fees =
+ Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti
+ in
+ String_map.singleton wire_method wire_fees
+ in
+ let wads =
+ (* TODO wads *)
+ []
+ in
+ let rewards_allowed = false in
+ let kyc_enabled = false in
+ let disable_direct_deposit = (* todo *) false in
+ let master_public_key = Config.master_public_key in
+ let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in
+ (* todo *)
+ let wallet_balance_limit_without_kyc = None in
+ let hard_limits = [] in
+ let zero_limits = [] in
+ let denom_data_l =
+ (* TODO sm-db *)
+ (*Pg.get_denominations db_conn |> unwrap_err_caqti *)
+ Sm.get_denoms_data ()
+ in
+ let denom_data_l =
+ (* reverse chronological order *)
+ List.sort
+ (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start)
+ denom_data_l
+ in
+ let list_issue_date =
+ match denom_data_l with
+ | [] -> Time.Timestamp.never
+ | v :: _ -> v.Denom_data.stamp_start
+ in
+ let denominations =
+ let open Denom_data in
+ (* if `?last_issue_date` query param does not exactly match the `stamp_start`
+ of one of the denomination keys, all keys are returned *)
+ let l =
+ match last_issue_date with
+ | None -> denom_data_l
+ | Some last_issue_date -> (
+ match
+ List.find_opt
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date = 0)
+ denom_data_l
+ with
+ | None -> denom_data_l
+ | Some _ ->
+ List.filter
+ (fun v ->
+ Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
+ denom_data_l)
+ in
+ List.map denomgroup_of_denomdata l
+ in
+
+ let signkeys =
+ (* TODO sm-db
+ use database signkey data / verify secmod and database are in sync *)
+ (*
+ let now = Ptime_clock.now () |> Option.some in
+ let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*)
+ let signkey_data_l = Sm.get_signkeys_data () in
+ let signkey_data_l =
+ List.sort
+ (fun a b ->
+ let open Signkey_data in
+ Stdlib.compare b.stamp_start a.stamp_start)
+ signkey_data_l
+ in
+ List.filter_map
+ (fun Signkey_data.
+ {
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig;
+ revoked_sig= _;
+ } ->
+ match master_sig with
+ | None -> None
+ | Some master_sig ->
+ Some
+ SignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; master_sig })
+ signkey_data_l
+ in
+
+ let exchange_pub =
+ (* the eddsa pub key used to sign exchange_sig *)
+ match signkeys with
+ | [] -> Fmt.failwith "exchange has no active signkey"
+ | v :: _ -> v.SignKey.key
+ in
+ let exchange_sig =
+ (* Compact EdDSA signature (binary-only) over the
+ contatentation of all of the master_sigs (in reverse
+ chronological order by group) in the arrays under "denominations". *)
+ let hc =
+ denom_data_l
+ |> List.filter_map (fun v -> v.Denom_data.master_sig)
+ |> List.map Signatures.DenominationKeyValidity.to_octets
+ |> String.concat ""
+ |> Hash.H64.hash
+ in
+ let open Signatures.ExchangeKeySet in
+ sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc }
+ in
+
+ let recoup = (* TODO /recoup *) [] in
+ let* global_fees =
+ Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti
+ in
+ let* auditors =
+ (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *)
+ (* does not contains auditor_keys with empty denomination_keys *)
+ Pg.get_auditor_keys db_conn
+ in
+ let extensions = None in
+ let extensions_sig = None in
+ Ok
+ ExchangeKeysResponse.
+ {
+ version;
+ base_url;
+ currency;
+ shopping_url;
+ open_banking_gateway;
+ bank_compliance_language;
+ currency_specification;
+ tiny_amount;
+ stefan_abs;
+ stefan_log;
+ stefan_lin;
+ asset_type;
+ accounts;
+ wire_fees;
+ wads;
+ rewards_allowed;
+ kyc_enabled;
+ disable_direct_deposit;
+ master_public_key;
+ reserve_closing_delay;
+ wallet_balance_limit_without_kyc;
+ hard_limits;
+ zero_limits;
+ denominations;
+ exchange_sig;
+ exchange_pub;
+ recoup;
+ global_fees;
+ list_issue_date;
+ auditors;
+ signkeys;
+ extensions;
+ extensions_sig;
+ }
+
+let jsont = ExchangeKeysResponse.jsont
+
+let keys req server _env =
+ Logs.info (fun m -> m "GET /keys");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* last_issue_date =
+ match Vif.Queries.get req "last_issue_date" with
+ | [] -> Ok None
+ | v :: _ -> (
+ match int_of_string_opt v with
+ | None ->
+ Error
+ "invalid `?last_issue_date` query param, int_of_string failure"
+ | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n))))
+ in
+ let* v = mk_keys ~db_conn sm ~last_issue_date in
+ let s = Api.encode_exn jsont v in
+ Ok s
+ in
+ Respond_util.respond_with_res res req
diff --git a/.jjconflict-side-1/src/http_management.ml b/.jjconflict-side-1/src/http_management.ml
new file mode 100644
index 00000000..29b08016
--- /dev/null
+++ b/.jjconflict-side-1/src/http_management.ml
@@ -0,0 +1,743 @@
+open Syntax
+open Api
+open Hash
+
+module Keys_get = struct
+ let mk_future_denom (module Sm : Secmod.S) ~section_name
+ ({
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig= _;
+ revoked_sig= _;
+ } :
+ Denom_data.t) =
+ let denom_pub =
+ DenominationKey.of_rsa RsaDenominationKey.{ age_mask; rsa_pub= pub }
+ in
+ let denom_secmod_sig =
+ let open Signatures.DenominationKeyAnnouncement in
+ let h_denom_pub = h_pub in
+ let h_section_name = Hash.Cstring.H64.hash section_name in
+ let anchor_time = stamp_start in
+ let duration_withdraw =
+ Timestamp.diff stamp_start stamp_expire_withdraw
+ in
+ sign_f ~f:Sm.sign_with_sm_key
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+ in
+ FutureDenom.
+ {
+ section_name;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig;
+ }
+
+ let mk_future_signkey (module Sm : Secmod.S)
+ ({
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig= _;
+ revoked_sig= _;
+ } :
+ Signkey_data.t) =
+ let signkey_secmod_sig =
+ let open Signatures.SigningKeyAnnouncement in
+ let exchange_pub = pub in
+ let anchor_time = stamp_start in
+ let duration = Timestamp.diff stamp_start stamp_expire in
+ sign_f ~f:Sm.sign_with_sm_key { exchange_pub; anchor_time; duration }
+ in
+ FutureSignKey.
+ { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
+
+ let mk_future_keys_response (module Sm : Secmod.S) =
+ let future_signkeys =
+ Sm.get_signkeys_data ()
+ |> List.filter (fun k -> Option.is_none k.Signkey_data.master_sig)
+ |> List.map (fun signkey -> mk_future_signkey (module Sm) signkey)
+ in
+ let future_denoms =
+ Sm.get_denoms_data ()
+ |> List.filter (fun k -> Option.is_none k.Denom_data.master_sig)
+ |> List.map (fun dn_data ->
+ let opt = Sm.find_denom_section_name dn_data.Denom_data.h_pub in
+ match opt with
+ | None -> Fmt.failwith "section_name not found."
+ | Some section_name ->
+ mk_future_denom (module Sm) ~section_name dn_data)
+ in
+ let master_pub = Config.Exchange.master_public_key in
+ let denom_secmod_public_key = Sm.get_sm_key_pub () in
+ let signkey_secmod_public_key = Sm.get_sm_key_pub () in
+ FutureKeysResponse.
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub;
+ denom_secmod_public_key;
+ signkey_secmod_public_key;
+ }
+
+ let jsont = FutureKeysResponse.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "GET /management/keys/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let v = mk_future_keys_response sm in
+ let s = Api.encode_exn jsont v in
+ Ok s
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Keys_post = struct
+ let verify_denom_signature (module Sm : Secmod.S)
+ DenomSignature.{ h_denom_pub; master_sig } =
+ let* denom =
+ match Sm.find_denom_data h_denom_pub with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some denom -> Ok denom
+ in
+ let open Signatures.DenominationKeyValidity in
+ let r : r =
+ {
+ master= Config.master_public_key;
+ start= denom.stamp_start;
+ expire_withdraw= denom.stamp_expire_withdraw;
+ expire_spend= denom.stamp_expire_deposit;
+ expire_legal= denom.stamp_expire_legal;
+ value= denom.value;
+ fee_withdraw= denom.fee_withdraw;
+ fee_deposit= denom.fee_deposit;
+ fee_refresh= denom.fee_refresh;
+ fee_refund= denom.fee_refund;
+ denom_hash= h_denom_pub;
+ }
+ in
+ verify_f ~f:Sm.verify_with_master_key master_sig r
+
+ let verify_signkey_signature (module Sm : Secmod.S)
+ SignKeySignature.{ key; master_sig } =
+ let* signkey =
+ match Sm.find_signkey_data key with
+ | None ->
+ Fmt.error
+ "404 not found, One of the keys for which a signature was provided \
+ is unknown to the exchange."
+ | Some signkey -> Ok signkey
+ in
+ let open Signatures.ExchangeSigningKeyValidity in
+ let r : r =
+ {
+ start= signkey.stamp_start;
+ expire= signkey.stamp_expire;
+ end_= signkey.stamp_end;
+ signkey_pub= signkey.pub;
+ }
+ in
+ verify_f ~f:Sm.verify_with_master_key master_sig r
+
+ let verify sm MasterSignatures.{ denom_sigs; signkey_sigs } =
+ let* () = list_iter (verify_denom_signature sm) denom_sigs in
+ let* () = list_iter (verify_signkey_signature sm) signkey_sigs in
+ Ok ()
+
+ (* TODO move to test *)
+ let check_master_signatures_update ~db_conn (module Sm : Secmod.S) =
+ Sm.get_denoms_data ()
+ |> list_iter (fun denom ->
+ let error = Error "update_master_signatures sanity check failure" in
+ let* opt =
+ Pg.find_denom db_conn denom.Denom_data.h_pub |> unwrap_err_caqti
+ in
+ let* v = match opt with None -> error | Some v -> Ok v in
+ let check = function false -> error | true -> Ok () in
+ let* () =
+ check (Timestamp.compare v.stamp_start denom.stamp_start = 0)
+ in
+ let* () = check (v.value = denom.value) in
+ let* () = check (v.fee_refund = denom.fee_refund) in
+ let* () = check (v.age_mask = denom.age_mask) in
+ Ok ())
+
+ let do_ ~db_conn (module Sm : Secmod.S)
+ MasterSignatures.{ denom_sigs; signkey_sigs } =
+ let* () =
+ signkey_sigs
+ |> List.map (fun SignKeySignature.{ key; master_sig } ->
+ (key, master_sig))
+ |> Sm.add_signkey_master_signatures
+ in
+ let* () =
+ denom_sigs
+ |> List.map (fun DenomSignature.{ h_denom_pub; master_sig } ->
+ (h_denom_pub, master_sig))
+ |> Sm.add_denom_master_signatures
+ in
+ let* () = Sm.store () in
+ let* () = check_master_signatures_update ~db_conn (module Sm) in
+ Ok ()
+
+ let jsont = MasterSignatures.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/keys/");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn sm v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Denom_revoke = struct
+ let verify (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let open Signatures.MasterDenominationKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { h_denom_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) h_denom_pub
+ DenomRevocationSignature.{ master_sig } =
+ let* () = Sm.revoke_denomination h_denom_pub master_sig in
+ let+ () =
+ Pg.insert_denomination_revocation db_conn h_denom_pub master_sig
+ |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = DenomRevocationSignature.jsont
+
+ let f req h_denom_pub server _env =
+ Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm h_denom_pub v in
+ let* () = do_ ~db_conn sm h_denom_pub v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Signkey_revoke = struct
+ let verify (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let open Signatures.MasterSigningKeyRevocation in
+ verify_f ~f:Sm.verify_with_master_key master_sig { exchange_pub }
+
+ let do_ ~db_conn (module Sm : Secmod.S) exchange_pub
+ SignkeyRevocationSignature.{ master_sig } =
+ let* () = Sm.revoke_signkey exchange_pub master_sig in
+ let+ () =
+ Pg.insert_signkey_revocation db_conn exchange_pub master_sig
+ |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = SignkeyRevocationSignature.jsont
+
+ let f req exchange_pub server _env =
+ Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let sm = Vif.Server.device Devices.secmod server in
+ let res =
+ let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm exchange_pub v in
+ let* () = do_ ~db_conn sm exchange_pub v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Auditors = struct
+ let verify (module Sm : Secmod.S)
+ AuditorSetupMessage.
+ {
+ auditor_url;
+ auditor_name= _;
+ auditor_pub;
+ master_sig;
+ validity_start;
+ } =
+ let open Signatures.MasterAddAuditor in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date= validity_start;
+ auditor_pub;
+ h_auditor_url= Hash.Cstring.H64.hash auditor_url;
+ }
+
+ (* TODO timestamps last_change +/- checks *)
+ (* todo: there is something about use of monotonic time
+ + protection against replay attack that I don't understand *)
+ let do_ ~db_conn v =
+ let auditor_pub = v.AuditorSetupMessage.auditor_pub in
+ let validity_start = v.AuditorSetupMessage.validity_start in
+ let* last_date_opt =
+ Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+ in
+ match last_date_opt with
+ | None ->
+ let+ () = Pg.insert_auditor db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "enabled auditor");
+ ()
+ | Some last_date ->
+ if Timestamp.compare last_date validity_start > 0 then
+ Error
+ "database has more recent auditor data for this auditor public key"
+ else
+ let+ () = Pg.update_auditor db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "updated auditor");
+ ()
+
+ let jsont = AuditorSetupMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/auditors/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Auditors_disable = struct
+ let verify (module Sm : Secmod.S) auditor_pub
+ AuditorTeardownMessage.{ master_sig; validity_end } =
+ let open Signatures.MasterDelAuditor in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ { end_date= validity_end; auditor_pub }
+
+ let do_ ~db_conn auditor_pub
+ AuditorTeardownMessage.{ master_sig= _; validity_end } =
+ let* last_date_opt =
+ Pg.get_auditor_timestamp db_conn auditor_pub |> unwrap_err_caqti
+ in
+ match last_date_opt with
+ | None -> Error "auditor not found"
+ | Some last_date ->
+ if Timestamp.compare last_date validity_end > 0 then
+ Error
+ "database has more recent auditor data for this auditor public key"
+ else
+ let+ () =
+ Pg.disable_auditor db_conn ~auditor_pub ~change_date:validity_end
+ |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = AuditorTeardownMessage.jsont
+
+ let f req auditor_pub server _env =
+ Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/revoke/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm auditor_pub v in
+ let* () = do_ ~db_conn auditor_pub v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Wire_fee = struct
+ let verify (module Sm : Secmod.S)
+ WireFeeSetupMessage.
+ {
+ wire_method;
+ master_sig_wire;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ } =
+ let open Signatures.MasterWireFee in
+ verify_f ~f:Sm.verify_with_master_key master_sig_wire
+ {
+ h_wire_method= Hash.Cstring.H64.hash wire_method;
+ start_date= fee_start;
+ end_date= fee_end;
+ wire_fee;
+ closing_fee;
+ }
+
+ let do_ ~db_conn (v : WireFeeSetupMessage.t) =
+ let* wire_fees =
+ Pg.get_wire_fees_by_time db_conn ~wire_method:v.wire_method
+ ~start_date:v.fee_start ~end_date:v.fee_end
+ |> unwrap_err_caqti
+ in
+ match wire_fees with
+ | [] ->
+ let+ () = Pg.insert_wire_fee db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "added wire fee");
+ ()
+ | [ vv ] -> (
+ match v.master_sig_wire = vv.sig_ with
+ | false ->
+ Error "a different wire-fee was already setup for this time frame"
+ | true ->
+ Logs.info (fun m -> m "an identical wire-fee was already setup");
+ Ok ())
+ | _ ->
+ Error
+ "invalid database state, multiple wire-fee found in database for \
+ this time frame"
+
+ let jsont = WireFeeSetupMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/wire-fee/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Global_fees = struct
+ let verify (module Sm : Secmod.S)
+ GlobalFees.
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ } =
+ let open Signatures.GlobalFees in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ }
+
+ let do_ ~db_conn v =
+ let* global_fees =
+ let start_date = v.GlobalFees.start_date in
+ let end_date = v.GlobalFees.end_date in
+ Pg.get_global_fees_by_time db_conn ~start_date ~end_date
+ |> unwrap_err_caqti
+ in
+ match global_fees with
+ | [] ->
+ let+ () = Pg.insert_global_fees db_conn v |> unwrap_err_caqti in
+ Logs.info (fun m -> m "added global fees");
+ ()
+ | [ vv ] -> (
+ match v.master_sig = vv.master_sig with
+ | false ->
+ Error
+ "a different global-fees was already setup for this time frame"
+ | true ->
+ Logs.info (fun m -> m "an identical global-fees was already setup");
+ Ok ())
+ | _ ->
+ Error
+ "invalid database state, multiple global-fees found in database for \
+ this time frame"
+
+ let jsont = GlobalFees.jsont
+
+ (* TODO global_fees
+ ensure it is defined for the current time.
+ there should be only one global_fees for each moment in time
+ and once set for a timeframe, it should not change. *)
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/global-fees/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Wire = struct
+ let verify (module Sm : Secmod.S)
+ WireSetupMessage.
+ {
+ payto_uri;
+ master_sig_wire;
+ master_sig_add;
+ validity_start;
+ bank_label= _;
+ priority= _;
+ } =
+ (* TODO wire *)
+ let conversion_url = "" in
+ let credit_restrictions = "" in
+ let debit_restrictions = "" in
+ let* () =
+ let open Signatures.MasterWireDetails in
+ verify_f ~f:Sm.verify_with_master_key master_sig_wire
+ {
+ h_wire_details= FullPaytoHash.hash payto_uri;
+ h_conversion_url= Hash.Cstring.H64.hash conversion_url;
+ h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
+ h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
+ }
+ in
+ let* () =
+ let open Signatures.MasterAddWire in
+ verify_f ~f:Sm.verify_with_master_key master_sig_add
+ {
+ start_date= validity_start;
+ h_wire= FullPaytoHash.hash payto_uri;
+ h_conversion_url= Hash.Cstring.H64.hash conversion_url;
+ h_credit_restrictions= Hash.Cstring.H64.hash credit_restrictions;
+ h_debit_restrictions= Hash.Cstring.H64.hash debit_restrictions;
+ }
+ in
+ Ok ()
+
+ let do_ ~db_conn v =
+ let* last_change_opt =
+ let payto_uri = v.WireSetupMessage.payto_uri in
+ Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+ in
+ match last_change_opt with
+ | Some _ -> Error "wire already setup"
+ | None ->
+ (* TODO wire *)
+ let last_change = Timestamp.of_ptime (Ptime_clock.now ()) in
+ let v =
+ ExchangeWireAccount.
+ {
+ payto_uri= v.payto_uri;
+ conversion_url= None;
+ debit_restrictions= [];
+ credit_restrictions= [];
+ master_sig= v.master_sig_wire;
+ bank_label= v.bank_label;
+ priority= v.priority;
+ }
+ in
+ let+ () = Pg.insert_wire db_conn ~last_change v |> unwrap_err_caqti in
+ ()
+
+ let jsont = WireSetupMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/wire/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Wire_disable = struct
+ let verify (module Sm : Secmod.S)
+ WireTeardownMessage.{ payto_uri; master_sig_del; validity_end } =
+ let open Signatures.MasterDelWire in
+ verify_f ~f:Sm.verify_with_master_key master_sig_del
+ { end_date= validity_end; h_wire= FullPaytoHash.hash payto_uri }
+
+ let do_ ~db_conn
+ WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } =
+ let* last_change_opt =
+ Pg.get_wire_timestamp db_conn ~payto_uri |> unwrap_err_caqti
+ in
+ match last_change_opt with
+ | None -> Error "wire not found"
+ | Some _ ->
+ let+ () =
+ Pg.disable_wire db_conn ~payto_uri ~validity_end |> unwrap_err_caqti
+ in
+ ()
+
+ let jsont = WireTeardownMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/wire/disable/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Drain = struct
+ let verify (module Sm : Secmod.S)
+ DrainProfitsMessage.
+ {
+ debit_account_section;
+ credit_payto_uri;
+ wtid;
+ master_sig;
+ date;
+ amount;
+ } =
+ let open Signatures.MasterDrainProfit in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ wtid;
+ date;
+ amount;
+ h_section= Hash.Cstring.H64.hash debit_account_section;
+ h_payto= FullPaytoHash.hash credit_payto_uri;
+ }
+
+ let do_ ~db_conn v =
+ let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in
+ ()
+
+ let jsont = DrainProfitsMessage.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/drain/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module AmlOfficer = struct
+ let verify (module Sm : Secmod.S)
+ AmlOfficerSetup.
+ {
+ officer_pub;
+ officer_name;
+ is_active;
+ read_only= _;
+ master_sig;
+ change_date;
+ } =
+ let open Signatures.MasterAmlOfficerStatus in
+ let is_active = match is_active with true -> 1_l | false -> 0_l in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ change_date;
+ officer_pub;
+ h_officer_name= Hash.Cstring.H64.hash officer_name;
+ is_active;
+ }
+
+ let do_ ~db_conn v =
+ let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_err_caqti in
+ ()
+
+ let jsont = AmlOfficerSetup.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/aml-officers/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
+
+module Partners = struct
+ let verify (module Sm : Secmod.S)
+ ExchangePartnerSetupRequest.
+ {
+ partner_base_url;
+ partner_pub;
+ wad_frequency;
+ master_sig;
+ start_date;
+ end_date;
+ wad_fee;
+ } =
+ let open Signatures.PartnerConfiguration in
+ verify_f ~f:Sm.verify_with_master_key master_sig
+ {
+ partner_pub;
+ start_date;
+ end_date;
+ wad_frequency;
+ wad_fee;
+ h_url= Hash.Cstring.H64.hash partner_base_url;
+ }
+
+ let do_ ~db_conn v =
+ let+ () = Pg.insert_partner db_conn v |> unwrap_err_caqti in
+ ()
+
+ let jsont = ExchangePartnerSetupRequest.jsont
+
+ let f req server _env =
+ Logs.info (fun m -> m "POST /management/partners/");
+ let sm = Vif.Server.device Devices.secmod server in
+ let db_conn = Vif.Server.device Devices.db_connection server in
+ let res =
+ let* v = Vif.Request.of_json req |> unwrap_err_msg in
+ let* () = verify sm v in
+ let* () = do_ ~db_conn v in
+ Ok ""
+ in
+ Respond_util.respond_with_res res req
+end
diff --git a/.jjconflict-side-1/src/mte.ml b/.jjconflict-side-1/src/mte.ml
new file mode 100644
index 00000000..abfc68a8
--- /dev/null
+++ b/.jjconflict-side-1/src/mte.ml
@@ -0,0 +1,83 @@
+(* 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 / "seed") --> Http_information.seed;
+ get_ (rel / "config") --> Http_information.config;
+ get_ (rel / "keys") --> Http_information.keys;
+ ]
+ in
+ let management =
+ let open Http_management in
+ let v s = rel / "management" / s in
+ [
+ get_ (v "keys") --> Keys_get.f;
+ post (v "keys") Keys_post.jsont --> Keys_post.f;
+ post (v "denominations" /% string `Path / "revoke") Denom_revoke.jsont
+ --> Denom_revoke.f;
+ post (v "signkeys" /% string `Path / "revoke") Signkey_revoke.jsont
+ --> Signkey_revoke.f;
+ post (v "auditors") Auditors.jsont --> Auditors.f;
+ post (v "auditors" /% string `Path / "disable") Auditors_disable.jsont
+ --> Auditors_disable.f;
+ post (v "wire-fee") Wire_fee.jsont --> Wire_fee.f;
+ post (v "global-fees") Global_fees.jsont --> Global_fees.f;
+ post (v "wire") Wire.jsont --> Wire.f;
+ post (v "wire" / "disable") Wire_disable.jsont --> Wire_disable.f;
+ post (v "drain") Drain.jsont --> Drain.f;
+ post (v "aml-officers") AmlOfficer.jsont --> AmlOfficer.f;
+ post (v "partners") Partners.jsont --> Partners.f;
+ ]
+ in
+ tos @ status_info @ management
+
+let () =
+ Util.Log_reporter.setup ();
+ let cfg =
+ let port = Config.Exchange.port in
+ let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
+ Vif.config ~reporter:Util.Log_reporter.reporter sockaddr
+ in
+ Miou_unix.run @@ fun () ->
+ Caqti_miou.Switch.run @@ fun caqti_switch ->
+ let env : Devices.env =
+ { caqti_switch; db_uri= Config.Exchangedb_postgres.config }
+ in
+ let devices = Vif.Devices.[ Devices.db_connection; Devices.secmod ] in
+ let middlewares = Vif.Middlewares.[] in
+ Logs.info (fun m ->
+ m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
+ Vif.run ~cfg ~devices ~middlewares routes env
diff --git a/.jjconflict-side-1/src/parse_config.ml b/.jjconflict-side-1/src/parse_config.ml
new file mode 100644
index 00000000..86254830
--- /dev/null
+++ b/.jjconflict-side-1/src/parse_config.ml
@@ -0,0 +1,232 @@
+(* rudimentary configuration file parser (INI-like)
+ https://docs.taler.net/manpages/taler-exchange.conf.5.html
+
+ do not support "$"-path expansion *)
+
+open Angstrom
+
+type item = {
+ key: string;
+ value: string;
+}
+
+type section = {
+ header: string;
+ items: item list;
+}
+
+let fail fmt =
+ let k _ppf = exit 1 in
+ Fmt.kpf k Fmt.stderr ("Configuration failure: " ^^ fmt ^^ ".@.")
+
+let is_eol = function '\n' | '\r' -> true | _ -> false
+let is_whitespace = function ' ' | '\t' -> true | _ -> false
+let blanks = skip_while is_whitespace
+
+module Config_section = struct
+ type t =
+ | Blank
+ | Comment of string
+ | Header of string
+ | Item of item
+
+ let id =
+ let ident_char = function
+ | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
+ | _ -> false
+ in
+ take_while1 ident_char >>| String.lowercase_ascii
+
+ let line = take_till is_eol <* end_of_line
+ let blank_line = blanks <* end_of_line >>| fun () -> Blank
+ let comment = blanks *> (char '#' <|> char '%') *> line >>| fun s -> Comment s
+
+ let header =
+ blanks *> char '[' *> id <* char ']' <* blanks <* end_of_line >>| fun s ->
+ Header s
+
+ let item_value =
+ let unquoted_value =
+ take_while1 (fun c -> not (is_whitespace c || is_eol c))
+ <* blanks
+ <* end_of_line
+ in
+ let quoted_value =
+ char '"' *> take_till is_eol <* end_of_line >>= fun s ->
+ match String.ends_with ~suffix:"\"" s && s <> "\"" with
+ | false -> fail "invalid quoted value"
+ | true ->
+ let value = String.sub s 0 (String.length s - 1) in
+ return value
+ in
+ quoted_value <|> unquoted_value
+
+ let item =
+ lift2
+ (fun key value -> Item { key; value })
+ id
+ (blanks *> char '=' *> blanks *> item_value)
+
+ let config =
+ many (choice [ blank_line; comment; header; item ]) <* end_of_input
+
+ let fold_sections l =
+ let rec loop section_l item_l l =
+ match l with
+ | [] ->
+ if List.is_empty item_l then section_l
+ else fail "invalid configuration structure"
+ | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
+ | Item item :: tl -> loop section_l (item :: item_l) tl
+ | Header header :: tl ->
+ let section = { header; items= item_l } in
+ loop (section :: section_l) [] tl
+ in
+ loop [] [] (List.rev l)
+
+ let parse s =
+ match parse_string ~consume:All config s with
+ | Error msg -> fail "parse error `%s`" msg
+ | Ok v -> fold_sections v
+end
+
+module Config_duration = struct
+ type duration_element = {
+ number: int;
+ dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
+ }
+
+ let integer =
+ take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
+ match int_of_string_opt s with
+ | None -> fail "expected integer, got `%s`" s
+ | Some i -> return i
+
+ let duration_element =
+ let number = blanks *> integer in
+ let dunit =
+ blanks *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
+ >>= function
+ | "year" | "years" -> return `Year
+ | "week" | "weeks" -> return `Week
+ | "day" | "days" -> return `Day
+ | "hour" | "hours" -> return `Hour
+ | "minute" | "minutes" -> return `Minute
+ | "second" | "seconds" | "s" -> return `Second
+ | s -> fail "expected a duration unit, got `%s`" s
+ in
+ lift2 (fun number dunit -> { number; dunit }) number dunit
+
+ let duration = many1 duration_element <* end_of_input
+
+ (* TODO put this in Time.Relative *)
+ let dunit_to_seconds u =
+ let rec f = function
+ | `Year -> 365 * f `Day
+ | `Week -> 7 * f `Day
+ | `Day -> 24 * f `Hour
+ | `Hour -> 60 * f `Minute
+ | `Minute -> 60 * f `Second
+ | `Second -> 1
+ in
+ f u
+
+ let to_time_span t =
+ List.fold_left
+ (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
+ 0 t
+ |> Int64.of_int
+ |> Time.Relative.of_s
+
+ let parse s : duration_element list =
+ match parse_string ~consume:All duration s with
+ | Error msg -> fail "duration parse error `%s`" msg
+ | Ok v -> v
+end
+
+let unwrap = function Error e -> fail "`%s`." e | Ok v -> v
+
+let get_opt t ~section ~field =
+ match List.find_opt (fun v -> v.header = section) t with
+ | None -> None
+ | Some v -> (
+ match List.find_opt (fun item -> item.key = field) v.items with
+ | None -> None
+ | Some item -> Some item.value)
+
+let get t ~section ~field =
+ match get_opt t ~section ~field with
+ | None -> fail "option `[%s].%s` not found" section field
+ | Some v -> v
+
+let int s =
+ match int_of_string_opt s with
+ | None -> fail "expected int value, got `%s`" s
+ | Some v -> v
+
+let float s =
+ match float_of_string_opt s with
+ | None -> fail "expected float value, got `%s`" s
+ | Some v -> v
+
+let const_value a b =
+ match a = b with false -> fail "unexpected value `%s`" b | true -> a
+
+let yes_no = function
+ | "NO" -> `NO
+ | "YES" -> `YES
+ | s -> fail "expected `YES`/`NO` value, got `%s`" s
+
+let uri s = Uri.of_string s
+let amount s = s |> Amount.of_string |> unwrap
+let duration s = Config_duration.(s |> parse |> to_time_span)
+
+let ed25519 s =
+ s
+ |> B32.decode
+ |> unwrap
+ |> Mirage_crypto_ec.Ed25519.pub_of_octets
+ |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
+ |> unwrap
+
+let etag s =
+ match Headers_lib.Etag.parse s with
+ | Ok etag -> etag
+ | Error e -> (
+ (* retry with quotes if needed *)
+ match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with
+ | Ok etag -> etag
+ | Error _ -> fail "could not parse etag `%s`: %s" s e)
+
+(* TODO
+ move to another module
+ can we type the json as a Int_map directly? *)
+module Alt_unit_names = struct
+ open Syntax
+ module String_map = Map.Make (String)
+
+ let string_map_jsont = Jsont.Object.as_string_map Jsont.string
+
+ let decode s =
+ let* string_map = Jsont_bytesrw.decode_string string_map_jsont s in
+ let l = String_map.to_list string_map in
+ let* l =
+ list_map
+ (fun (k, v) ->
+ match int_of_string_opt k with
+ | None -> Error "alt_unit_names has a non-integer key"
+ | Some k -> Ok (k, v))
+ l
+ in
+ match List.find_opt (fun (i, _) -> i = 0) l with
+ | None -> Error "alt_unit_names with no entry for base value \"0\""
+ | Some _ -> Ok l
+
+ let encode l =
+ let l = List.map (fun (k, v) -> (string_of_int k, v)) l in
+ let string_map = String_map.of_list l in
+ let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in
+ s
+
+ let encode_exn l = encode l |> Result.get_ok
+end
diff --git a/.jjconflict-side-1/src/pg.ml b/.jjconflict-side-1/src/pg.ml
new file mode 100644
index 00000000..32428045
--- /dev/null
+++ b/.jjconflict-side-1/src/pg.ml
@@ -0,0 +1,374 @@
+(* TODO
+
+ check there is no issues with signed/unsigned integers
+
+ how to fix postgres/caqti tuple type?
+ try something with OID?
+ need to add boilerplate in each query for amounts
+
+ GNU Taler db-events?
+ it seems caqti/pgx does not support it
+
+ transaction
+
+ should check validity of signatures got from db, for /management at least
+
+ clean up caqti error type *)
+(* TODO time
+ fix comparison with timestamp footgun *)
+
+module type CONN = Caqti_miou.CONNECTION
+
+module Caqti_type = struct
+ include Caqti_type
+ include Pg_type
+ include Caqti_request.Infix
+end
+
+open Crypto
+open Api
+
+let preflight =
+ let l =
+ List.map
+ Caqti_type.(unit ->. unit)
+ [
+ "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL \
+ SERIALIZABLE;";
+ "SET enable_sort=OFF;";
+ "SET enable_seqscan=OFF;";
+ "SET enable_mergejoin=OFF;";
+ "SET search_path TO exchange;";
+ ]
+ in
+ fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l
+
+let find_signkey =
+ let find_signkey =
+ Caqti_type.(eddsa_pub ->? signkey_data)
+ "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
+ esk.expire_legal, esk.master_sig, skr.master_sig FROM \
+ exchange_sign_keys AS esk LEFT JOIN signkey_revocations AS skr ON \
+ esk.esk_serial = skr.esk_serial WHERE esk.exchange_pub=$1"
+ in
+ fun (module Conn : CONN) (exchange_pub : EddsaPublicKey.t) ->
+ Conn.find_opt find_signkey exchange_pub
+
+let get_active_signkeys =
+ let get_active_signkeys =
+ Caqti_type.(time ->* signkey_data)
+ "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
+ esk.expire_legal, esk.master_sig, NULL FROM exchange_sign_keys esk \
+ WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \
+ signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)"
+ in
+ fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now
+
+(* note: does not update revocation *)
+let insert_signkey =
+ let insert_signkey =
+ Caqti_type.(signkey_data ->. unit)
+ "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
+ expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_signkey v
+
+let find_denom =
+ let find_denom =
+ Caqti_type.(denomination_hash ->? denom_data)
+ "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
+ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
+ (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
+ dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
+ dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
+ = dnr.denominations_serial WHERE dn.denom_pub_hash=$1"
+ in
+ fun (module Conn : CONN) h_denom_pub -> Conn.find_opt find_denom h_denom_pub
+
+let get_denominations =
+ let get_denominations =
+ Caqti_type.(unit ->* denom_data)
+ "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
+ dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
+ (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
+ dn.denom_pub_hash, dn.master_sig, dnr.master_sig FROM denominations AS \
+ dn LEFT JOIN denomination_revocations AS dnr ON dn.denominations_serial \
+ = dnr.denominations_serial"
+ in
+ fun (module Conn : CONN) -> Conn.collect_list get_denominations ()
+
+(* note: does not update revocation *)
+let insert_denom =
+ let insert_denom =
+ Caqti_type.(denom_data ->. unit)
+ "INSERT INTO denominations (denom_pub, coin, valid_from, \
+ expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \
+ fee_deposit, fee_refresh, fee_refund, age_mask, denom_pub_hash, \
+ master_sig) VALUES ($1, ($2, $3), $4, $5, $6, $7, ($8,$9), ($10,$11), \
+ ($12,$13), ($14,$15), $16, $17, $18)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_denom v
+
+let insert_denomination_revocation =
+ let denomination_revocation_insert =
+ let master_sig = Signatures.MasterDenominationKeyRevocation.caqti in
+ Caqti_type.(t2 denomination_hash master_sig ->. unit)
+ "INSERT INTO denomination_revocations (denominations_serial, master_sig) \
+ SELECT denominations_serial, $2 FROM denominations WHERE \
+ denom_pub_hash=$1"
+ in
+ fun (module Conn : CONN) h_denom_pub master_sig ->
+ Conn.exec denomination_revocation_insert (h_denom_pub, master_sig)
+
+let insert_signkey_revocation =
+ let signkey_revocation_insert =
+ let master_sig = Signatures.MasterSigningKeyRevocation.caqti in
+ Caqti_type.(t2 eddsa_pub master_sig ->. unit)
+ "INSERT INTO signkey_revocations (esk_serial, master_sig) SELECT \
+ esk_serial, $2 FROM exchange_sign_keys WHERE exchange_pub=$1"
+ in
+ fun (module Conn : CONN) exchange_pub master_sig ->
+ Conn.exec signkey_revocation_insert (exchange_pub, master_sig)
+
+let get_auditor_timestamp =
+ let get_auditor_timestamp =
+ Caqti_type.(eddsa_pub ->? time)
+ "SELECT last_change FROM auditors WHERE auditor_pub=$1"
+ in
+ fun (module Conn : CONN) auditor_pub ->
+ Conn.find_opt get_auditor_timestamp auditor_pub
+
+let insert_auditor =
+ let insert_auditor =
+ Caqti_type.(t4 eddsa_pub string string time ->. unit)
+ "INSERT INTO auditors (auditor_pub, auditor_name, auditor_url, \
+ is_active, last_change) VALUES ($1, $2, $3, true, $4)"
+ in
+ fun (module Conn : CONN)
+ AuditorSetupMessage.
+ { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
+ ->
+ Conn.exec insert_auditor
+ (auditor_pub, auditor_name, auditor_url, validity_start)
+
+let update_auditor =
+ let update_auditor =
+ Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
+ "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
+ last_change=$5 WHERE auditor_pub=$1"
+ in
+ fun (module Conn : CONN)
+ AuditorSetupMessage.
+ { auditor_url; auditor_name; auditor_pub; master_sig= _; validity_start }
+ ->
+ Conn.exec update_auditor
+ (auditor_pub, auditor_url, auditor_name, true, validity_start)
+
+let disable_auditor =
+ let update_auditor =
+ Caqti_type.(t5 eddsa_pub string string bool time ->. unit)
+ "UPDATE auditors SET auditor_url=$2, auditor_name=$3, is_active=$4, \
+ last_change=$5 WHERE auditor_pub=$1"
+ in
+ fun (module Conn : CONN) ~auditor_pub ~change_date ->
+ Conn.exec update_auditor (auditor_pub, "", "", false, change_date)
+
+let insert_auditor_denom_sig =
+ let insert_auditor_denom_sig =
+ let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
+ Caqti_type.(t3 eddsa_pub denomination_hash auditor_sig ->. unit)
+ "WITH ax AS (SELECT auditor_uuid FROM auditors WHERE auditor_pub=$1) \
+ INSERT INTO auditor_denom_sigs (auditor_uuid, denominations_serial, \
+ auditor_sig) SELECT ax.auditor_uuid, denominations_serial, $3 FROM \
+ denominations CROSS JOIN ax WHERE denom_pub_hash=$2 ON CONFLICT DO \
+ NOTHING"
+ in
+ fun (module Conn : CONN) ~auditor_pub ~h_denom_pub ~auditor_sig ->
+ Conn.exec insert_auditor_denom_sig (auditor_pub, h_denom_pub, auditor_sig)
+
+(* todo auditors
+ maybe check that url and name are unique/same for each auditor_pub
+ and do the ht logic out of pg.ml? *)
+(* this does not return auditors that are not auditing any denom *)
+let get_auditor_keys =
+ let get_auditor_keys =
+ let auditor_sig = Signatures.ExchangeKeyValidity.caqti in
+ Caqti_type.(
+ unit ->* t5 eddsa_pub string string denomination_hash auditor_sig)
+ "SELECT a.auditor_pub, a.auditor_url, a.auditor_name, dn.denom_pub_hash, \
+ ads.auditor_sig FROM auditor_denom_sigs AS ads JOIN auditors AS a USING \
+ (auditor_uuid) JOIN denominations AS dn USING (denominations_serial) \
+ WHERE a.is_active"
+ in
+ fun (module Conn : CONN) ->
+ let open Syntax in
+ let* l = Conn.collect_list get_auditor_keys () |> unwrap_err_caqti in
+ let ht = Hashtbl.create 0xff in
+ List.iter
+ (fun (pub, url, name, denom_pub_h, auditor_sig) ->
+ let k = (pub, url, name) in
+ match Hashtbl.find_opt ht k with
+ | None -> Hashtbl.replace ht k [ (denom_pub_h, auditor_sig) ]
+ | Some l -> Hashtbl.replace ht k ((denom_pub_h, auditor_sig) :: l))
+ l;
+ let l = Hashtbl.to_seq ht |> List.of_seq in
+ let l =
+ List.map
+ (fun ((auditor_pub, auditor_url, auditor_name), auditor_denoms) ->
+ let denomination_keys =
+ List.map
+ (fun (denom_pub_h, auditor_sig) ->
+ AuditorDenominationKey.{ denom_pub_h; auditor_sig })
+ auditor_denoms
+ in
+ AuditorKeys.
+ { auditor_pub; auditor_url; auditor_name; denomination_keys })
+ l
+ in
+ Ok l
+
+let insert_wire_fee =
+ let insert_wire_fee =
+ let master_sig = Signatures.MasterWireFee.caqti in
+ Caqti_type.(t6 wire_method time time amount amount master_sig ->. unit)
+ "INSERT INTO wire_fee (wire_method, start_date, end_date, wire_fee, \
+ closing_fee, master_sig) VALUES ($1, $2, $3, ($4,$5), ($6,$7), $8)"
+ in
+ fun (module Conn : CONN)
+ WireFeeSetupMessage.
+ {
+ wire_method;
+ master_sig_wire;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ }
+ ->
+ Conn.exec insert_wire_fee
+ (wire_method, fee_start, fee_end, wire_fee, closing_fee, master_sig_wire)
+
+let get_wire_fees_by_time =
+ let get_wire_fee_by_time =
+ Caqti_type.(t3 wire_method time time ->* aggregate_transfer_fee)
+ "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
+ FROM wire_fee WHERE wire_method=$1 AND end_date > $2 AND start_date < \
+ $3"
+ in
+ fun (module Conn : CONN) ~wire_method ~start_date ~end_date ->
+ Conn.collect_list get_wire_fee_by_time (wire_method, start_date, end_date)
+
+let get_wire_fees =
+ let get_wire_fees =
+ Caqti_type.(string ->* aggregate_transfer_fee)
+ "SELECT (wire_fee).*, (closing_fee).*, start_date, end_date, master_sig \
+ FROM wire_fee WHERE wire_method=$1"
+ in
+ fun (module Conn : CONN) ~wire_method ->
+ Conn.collect_list get_wire_fees wire_method
+
+let get_global_fees =
+ let get_global_fees =
+ Caqti_type.(time ->* global_fee)
+ "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
+ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
+ master_sig FROM global_fee WHERE start_date >= $1"
+ in
+ fun (module Conn : CONN) ~start_date ->
+ Conn.collect_list get_global_fees start_date
+
+let get_global_fees_by_time =
+ let get_global_fees_by_time =
+ Caqti_type.(t2 time time ->* global_fee)
+ "SELECT start_date, end_date, (history_fee).*, (account_fee).*, \
+ (purse_fee).*, history_expiration, purse_account_limit, purse_timeout, \
+ master_sig FROM global_fee WHERE start_date >= $1 AND end_date <= $2"
+ in
+ fun (module Conn : CONN) ~start_date ~end_date ->
+ Conn.collect_list get_global_fees_by_time (start_date, end_date)
+
+let insert_global_fees =
+ let insert_global_fees =
+ Caqti_type.(global_fee ->. unit)
+ "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
+ purse_fee, history_expiration, purse_account_limit, purse_timeout, \
+ master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
+ $12)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_global_fees v
+
+let get_wire_timestamp =
+ let get_wire_timestamp =
+ Caqti_type.(payto_uri ->? time)
+ "SELECT last_change FROM wire_accounts WHERE payto_uri=$1"
+ in
+ fun (module Conn : CONN) ~payto_uri ->
+ Conn.find_opt get_wire_timestamp payto_uri
+
+let insert_wire =
+ let insert_wire =
+ Caqti_type.(t3 exchange_wire_account bool time ->. unit)
+ "INSERT INTO wire_accounts (payto_uri, conversion_url, \
+ credit_restrictions, debit_restrictions, master_sig, bank_label, \
+ priority, is_active, last_change) VALUES \
+ ($1,$2,$3::TEXT::JSONB,$4::TEXT::JSONB,$5,$6,$7,true,$8)"
+ in
+ fun (module Conn : CONN) ~last_change v ->
+ let is_active = true in
+ Conn.exec insert_wire (v, is_active, last_change)
+
+let update_wire =
+ let update_wire =
+ Caqti_type.(t3 exchange_wire_account bool time ->. unit)
+ "UPDATE wire_accounts SET conversion_url=$2, \
+ debit_restrictions=$3::TEXT::JSONB, \
+ credit_restrictions=$4::TEXT::JSONB, master_sig=$5, bank_label=$6, \
+ priority=$7, is_active=$8, last_change=$9 WHERE payto_uri=$1"
+ in
+ fun (module Conn : CONN) ~is_active ~last_change v ->
+ Conn.exec update_wire (v, is_active, last_change)
+
+let disable_wire =
+ let disable_wire =
+ (* TODO check syntax on this *)
+ Caqti_type.(t2 payto_uri time ->. unit)
+ "UPDATE wire_accounts SET conversion_url=NULL, debit_restrictions=NULL, \
+ credit_restrictions=NULL, master_sig=NULL, bank_label=NULL, \
+ priority=NULL, is_active=FALSE, last_change=$2 WHERE payto_uri=$1"
+ in
+ fun (module Conn : CONN) ~payto_uri ~validity_end ->
+ Conn.exec disable_wire (payto_uri, validity_end)
+
+let get_wire_accounts =
+ let get_wire_accounts =
+ Caqti_type.(unit ->* exchange_wire_account)
+ "SELECT payto_uri, conversion_url, debit_restrictions::TEXT, \
+ credit_restrictions::TEXT, master_sig, bank_label, priority FROM \
+ wire_accounts WHERE is_active"
+ in
+ fun (module Conn : CONN) -> Conn.collect_list get_wire_accounts ()
+
+let insert_drain_profit =
+ let insert_drain_profit =
+ Caqti_type.(drain_profit_message ->. unit)
+ "INSERT INTO profit_drains (wtid, account_section, payto_uri, \
+ trigger_date, amount, master_sig) VALUES ($1, $2, $3, $4, ($5,$6), $7)"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_drain_profit v
+
+let insert_aml_officer =
+ let exchange_do_insert_aml_officer =
+ Caqti_type.(aml_officer_setup ->! time)
+ "SELECT out_last_change FROM exchange_do_insert_aml_officer ($1, $2, $3, \
+ $4, $5, $6)"
+ in
+ fun (module Conn : CONN) v -> Conn.find exchange_do_insert_aml_officer v
+
+let insert_partner =
+ let insert_partner =
+ Caqti_type.(exchange_partner_setup ->. unit)
+ "INSERT INTO partners (partner_master_pub, start_date, end_date, \
+ wad_frequency, wad_fee, master_sig, partner_base_url) VALUES ($1, $2, \
+ $3, $4, ($5,$6), $7, $8) ON CONFLICT DO NOTHING"
+ in
+ fun (module Conn : CONN) v -> Conn.exec insert_partner v
diff --git a/.jjconflict-side-1/src/pg_type.ml b/.jjconflict-side-1/src/pg_type.ml
new file mode 100644
index 00000000..0a2e8f15
--- /dev/null
+++ b/.jjconflict-side-1/src/pg_type.ml
@@ -0,0 +1,377 @@
+(* this module defines caqti encoding/decodings *)
+open Caqti_type
+open Crypto
+open Api
+
+(* TODO
+ check that we use Caqti_type.octets for binary data *)
+
+let amount : Amount.t t =
+ let open Amount in
+ custom
+ ~encode:(fun amount -> Ok (amount.value, amount.fraction))
+ ~decode:(fun (value, fraction) ->
+ Amount.make ~sign:None ~currency:Config.currency ~value ~fraction)
+ (t2 int64 int32)
+
+(* we want to use int64 timestamps,
+ not postgresql built-in timestamp type *)
+let ptime : unit t = Caqti_type.unit
+let time = Timestamp.caqti
+let time_span = Time.Relative.caqti
+let age_mask : int t = Caqti_type.int
+let rsa_pub = RsaPublicKey.caqti
+let eddsa_pub = EddsaPublicKey.caqti
+let eddsa_sig = EddsaSignature.caqti
+
+(* todo: enum type for wire_method? *)
+let wire_method = Caqti_type.string
+let payto_uri = Caqti_type.string
+let b32 = B32.caqti
+
+include struct
+ (* alias for hash *)
+ open Hash
+
+ let fullpayto_hash = FullPaytoHash.caqti
+ let nomalizaedpayto_hash = NormalizedPaytoHash.caqti
+ let denomination_hash = DenominationHash.caqti
+ let privatecontract_hash = PrivateContractHash.caqti
+ let extensionspolicy_hash = ExtensionsPolicyHash.caqti
+ let merchantwire_hash = MerchantWireHash.caqti
+ let agecommitment_hash = AgeCommitmentHash.caqti
+ let blindedcoin_hash = BlindedCoinHash.caqti
+ let coinpub_hash = CoinPubHash.caqti
+ let outputcommitment_hash = OutputCommitmentHash.caqti
+ let planchets_hash = HashPlanchetsP.caqti
+end
+
+let signkey_data =
+ let master_sig = Signatures.ExchangeSigningKeyValidity.caqti in
+ let revoked_sig = option Signatures.MasterSigningKeyRevocation.caqti in
+ custom
+ ~encode:(fun
+ Signkey_data.
+ { pub; stamp_start; stamp_expire; stamp_end; master_sig; revoked_sig }
+ ->
+ match master_sig with
+ | None -> Error "signkey_data master_sig is none"
+ | Some master_sig ->
+ Ok (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig))
+ ~decode:(fun
+ (pub, stamp_start, stamp_expire, stamp_end, master_sig, revoked_sig) ->
+ Ok
+ {
+ pub;
+ stamp_start;
+ stamp_expire;
+ stamp_end;
+ master_sig= Some master_sig;
+ revoked_sig;
+ })
+ (t6 eddsa_pub time time time master_sig revoked_sig)
+
+let denom_data =
+ let master_sig = Signatures.DenominationKeyValidity.caqti in
+ let revoked_sig = option Signatures.MasterDenominationKeyRevocation.caqti in
+ custom
+ ~encode:(fun
+ Denom_data.
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig;
+ revoked_sig;
+ }
+ ->
+ match master_sig with
+ | None -> Error "denom_data master_sig is none"
+ | Some master_sig ->
+ Ok
+ ( pub,
+ value,
+ stamp_start,
+ stamp_expire_withdraw,
+ stamp_expire_deposit,
+ stamp_expire_legal,
+ fee_withdraw,
+ fee_deposit,
+ fee_refresh,
+ fee_refund,
+ age_mask,
+ (h_pub, master_sig, revoked_sig) ))
+ ~decode:(fun
+ ( pub,
+ value,
+ stamp_start,
+ stamp_expire_withdraw,
+ stamp_expire_deposit,
+ stamp_expire_legal,
+ fee_withdraw,
+ fee_deposit,
+ fee_refresh,
+ fee_refund,
+ age_mask,
+ (h_pub, master_sig, revoked_sig) )
+ ->
+ Ok
+ {
+ pub;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ age_mask;
+ h_pub;
+ master_sig= Some master_sig;
+ revoked_sig;
+ })
+ (t12 rsa_pub amount time time time time amount amount amount amount int
+ (t3 denomination_hash master_sig revoked_sig))
+
+let account_restrictions =
+ custom
+ ~encode:(fun l -> Api.encode (Jsont.list AccountRestriction.jsont) l)
+ ~decode:(fun s -> Api.decode (Jsont.list AccountRestriction.jsont) s)
+ string
+
+let global_fee =
+ let master_sig = Signatures.GlobalFees.caqti in
+ custom
+ ~encode:(fun
+ GlobalFees.
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ }
+ ->
+ Ok
+ ( start_date,
+ end_date,
+ history_fee,
+ account_fee,
+ purse_fee,
+ history_expiration,
+ purse_account_limit,
+ purse_timeout,
+ master_sig ))
+ ~decode:(fun
+ ( start_date,
+ end_date,
+ history_fee,
+ account_fee,
+ purse_fee,
+ history_expiration,
+ purse_account_limit,
+ purse_timeout,
+ master_sig )
+ ->
+ Ok
+ {
+ start_date;
+ end_date;
+ history_fee;
+ account_fee;
+ purse_fee;
+ history_expiration;
+ purse_account_limit;
+ purse_timeout;
+ master_sig;
+ })
+ Caqti_type.(
+ t9 time time amount amount amount time_span int32 time_span master_sig)
+
+let aggregate_transfer_fee =
+ let master_sig = Signatures.MasterWireFee.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ AggregateTransferFee.
+ { wire_fee; closing_fee; start_date; end_date; sig_ }
+ -> Ok (wire_fee, closing_fee, start_date, end_date, sig_))
+ ~decode:(fun (wire_fee, closing_fee, start_date, end_date, sig_) ->
+ Ok
+ AggregateTransferFee.
+ { wire_fee; closing_fee; start_date; end_date; sig_ })
+ Caqti_type.(t5 amount amount time time master_sig)
+
+let exchange_wire_account =
+ let master_sig = Signatures.MasterWireDetails.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ ExchangeWireAccount.
+ {
+ payto_uri;
+ conversion_url;
+ debit_restrictions;
+ credit_restrictions;
+ master_sig;
+ bank_label;
+ priority;
+ }
+ ->
+ Ok
+ ( payto_uri,
+ conversion_url,
+ debit_restrictions,
+ credit_restrictions,
+ master_sig,
+ bank_label,
+ priority ))
+ ~decode:(fun
+ ( payto_uri,
+ conversion_url,
+ debit_restrictions,
+ credit_restrictions,
+ master_sig,
+ bank_label,
+ priority )
+ ->
+ Ok
+ {
+ payto_uri;
+ conversion_url;
+ debit_restrictions;
+ credit_restrictions;
+ master_sig;
+ bank_label;
+ priority;
+ })
+ Caqti_type.(
+ t7 payto_uri (option string) account_restrictions account_restrictions
+ master_sig (option string) (option int))
+
+let drain_profit_message =
+ let master_sig = Signatures.MasterDrainProfit.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ DrainProfitsMessage.
+ {
+ wtid;
+ debit_account_section;
+ credit_payto_uri;
+ date;
+ amount;
+ master_sig;
+ }
+ ->
+ Ok
+ (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig))
+ ~decode:(fun
+ (wtid, debit_account_section, credit_payto_uri, date, amount, master_sig)
+ ->
+ Ok
+ {
+ wtid;
+ debit_account_section;
+ credit_payto_uri;
+ date;
+ amount;
+ master_sig;
+ })
+ Caqti_type.(t6 b32 string string time amount master_sig)
+
+let aml_officer_setup =
+ let master_sig = Signatures.MasterAmlOfficerStatus.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ AmlOfficerSetup.
+ {
+ officer_pub;
+ master_sig;
+ officer_name;
+ is_active;
+ read_only;
+ change_date;
+ }
+ ->
+ Ok
+ ( officer_pub,
+ master_sig,
+ officer_name,
+ is_active,
+ read_only,
+ change_date ))
+ ~decode:(fun
+ ( officer_pub,
+ master_sig,
+ officer_name,
+ is_active,
+ read_only,
+ change_date )
+ ->
+ Ok
+ {
+ officer_pub;
+ master_sig;
+ officer_name;
+ is_active;
+ read_only;
+ change_date;
+ })
+ Caqti_type.(t6 eddsa_pub master_sig string bool bool time)
+
+let exchange_partner_setup =
+ let master_sig = Signatures.PartnerConfiguration.caqti in
+ Caqti_type.custom
+ ~encode:(fun
+ ExchangePartnerSetupRequest.
+ {
+ partner_pub;
+ start_date;
+ end_date;
+ wad_frequency;
+ wad_fee;
+ master_sig;
+ partner_base_url;
+ }
+ ->
+ Ok
+ ( partner_pub,
+ start_date,
+ end_date,
+ wad_frequency,
+ wad_fee,
+ master_sig,
+ partner_base_url ))
+ ~decode:(fun
+ ( partner_pub,
+ start_date,
+ end_date,
+ wad_frequency,
+ wad_fee,
+ master_sig,
+ partner_base_url )
+ ->
+ Ok
+ {
+ partner_base_url;
+ partner_pub;
+ wad_frequency;
+ master_sig;
+ start_date;
+ end_date;
+ wad_fee;
+ })
+ Caqti_type.(t7 eddsa_pub time time time_span amount master_sig string)
diff --git a/.jjconflict-side-1/src/respond_util.ml b/.jjconflict-side-1/src/respond_util.ml
new file mode 100644
index 00000000..0303c12c
--- /dev/null
+++ b/.jjconflict-side-1/src/respond_util.ml
@@ -0,0 +1,25 @@
+(* TODO response
+ use ErrorDetail *)
+
+let respond_with_plain_text_error ?status e req =
+ let open Vif.Response in
+ let open Syntax in
+ let status = Option.value ~default:`Bad_request status in
+ let* () = add ~field:"content-type" "text/plain; charset=utf-8" in
+ let* () = with_string req e in
+ respond status
+
+let respond_with_ok_json content req =
+ let open Vif.Response in
+ let open Syntax in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string req content in
+ respond `OK
+
+let respond_with_res res req =
+ match res with
+ | Error err ->
+ Logs.err (fun m -> m "%s." err);
+ let err = Fmt.str "%s@." err in
+ respond_with_plain_text_error err req
+ | Ok content -> respond_with_ok_json content req
diff --git a/.jjconflict-side-1/src/secmod.ml b/.jjconflict-side-1/src/secmod.ml
new file mode 100644
index 00000000..528db20d
--- /dev/null
+++ b/.jjconflict-side-1/src/secmod.ml
@@ -0,0 +1,411 @@
+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 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.(Config.secrets_dir / "sk_sm")
+ in
+ let* signkeys =
+ let l =
+ List.init 1 (fun i -> Fpath.(Config.secrets_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.(Config.secrets_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.(Config.secrets_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.(Config.secrets_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.(Config.secrets_dir / section_name) in
+ (fname, key.priv))
+ in
+ list_iter (fun (fname, key) -> Data_file.write_rsa fname key) l
+ in
+ Logs.info (fun m -> m "stored secmod data to file");
+ Ok ()
+end
diff --git a/.jjconflict-side-1/src/secmod.mli b/.jjconflict-side-1/src/secmod.mli
new file mode 100644
index 00000000..0205b866
--- /dev/null
+++ b/.jjconflict-side-1/src/secmod.mli
@@ -0,0 +1,46 @@
+module type S = sig
+ open Crypto
+
+ val sign_with_sm_key : string -> eddsa_sig
+ val sign_with_signkey : pub:eddsa_pub -> string -> eddsa_sig
+ val verify_with_master_key : eddsa_sig -> msg:string -> (unit, string) result
+ val verify_with_sm_key : eddsa_sig -> msg:string -> (unit, string) result
+
+ val verify_with_signkey :
+ pub:eddsa_pub -> eddsa_sig -> msg:string -> (unit, string) result
+
+ (* TODO query database instead? *)
+ val get_sm_key_pub : unit -> eddsa_pub
+ val get_signkeys_data : unit -> Signkey_data.t list
+ val get_denoms_data : unit -> Denom_data.t list
+ val find_signkey_data : eddsa_pub -> Signkey_data.t option
+ val find_denom_data : denomination_hash -> Denom_data.t option
+ val find_denom_section_name : denomination_hash -> string option
+
+ (* - management operations - *)
+ (* TODO
+ problem of keeping db and secmod state syncronized
+ do db interaction from secmod? *)
+
+ val add_signkey_master_signatures :
+ (eddsa_pub * Signatures.ExchangeSigningKeyValidity.t) list ->
+ (unit, string) result
+
+ val add_denom_master_signatures :
+ (denomination_hash * Signatures.DenominationKeyValidity.t) list ->
+ (unit, string) result
+
+ val revoke_signkey :
+ eddsa_pub ->
+ Signatures.MasterSigningKeyRevocation.t ->
+ (unit, string) result
+
+ val revoke_denomination :
+ denomination_hash ->
+ Signatures.MasterDenominationKeyRevocation.t ->
+ (unit, string) result
+
+ val store : unit -> (unit, string) result
+end
+
+module Make (_ : Pg.CONN) : S
diff --git a/.jjconflict-side-1/src/signatures.ml b/.jjconflict-side-1/src/signatures.ml
new file mode 100644
index 00000000..4855835c
--- /dev/null
+++ b/.jjconflict-side-1/src/signatures.ml
@@ -0,0 +1,1312 @@
+(* TODO debug sig
+ check with taler-wallet-core/src/crypto/cryptoImplementation.js
+ unsigned-ints
+
+ can we skip defining a specific record for signatures and directly use Api records? *)
+open Hash
+
+module Aliases = struct
+ module Timestamp = struct
+ type t = Time.Timestamp.t
+
+ let bin = Time.Timestamp.bin
+ end
+
+ module TimestampNBO = struct
+ type t = Time.Timestamp.t
+
+ let bin = Time.Timestamp.bin_nbo
+ end
+
+ module TimeRelative = struct
+ type t = Time.Relative.t
+
+ let bin = Time.Relative.bin
+ end
+
+ module TimeRelativeNBO = struct
+ type t = Time.Relative.t
+
+ let bin = Time.Relative.bin_nbo
+ end
+
+ module AmountNBO = struct
+ type t = Amount.t
+
+ let bin = Amount.bin_nbo
+ end
+
+ (* - Keys - *)
+
+ (* some of those are actuall ecdhe, or union of eddsa|ecdhe *)
+ open Crypto
+ module PursePublicKey = EddsaPublicKey
+ module AuditorPublicKeyP = EddsaPublicKey
+ module ReservePublicKeyP = EddsaPublicKey
+ module MerchantPublicKeyP = EddsaPublicKey
+ module TransferPublicKeyP = EddsaPublicKey
+ module AmlOfficerPublicKeyP = EddsaPublicKey
+ module ExchangePublicKeyP = EddsaPublicKey
+ module MasterPublicKeyP = EddsaPublicKey
+ module CoinSpendPublicKeyP = EddsaPublicKey
+ module TokenPublicKeyP = EddsaPublicKey
+ module ReservePrivateKeyP = EddsaPrivateKey
+ module MerchantPrivateKeyP = EddsaPrivateKey
+ module TransferPrivateKeyP = EddsaPrivateKey
+ module AmlOfficerPrivateKeyP = EddsaPrivateKey
+ module ExchangePrivateKeyP = EddsaPrivateKey
+ module MasterPrivateKeyP = EddsaPrivateKey
+ module CoinSpendPrivateKeyP = EddsaPrivateKey
+ module MasterSignatureP = EddsaSignature
+ module ReserveSignatureP = EddsaSignature
+ module ExchangeSignatureP = EddsaSignature
+ module CoinSpendSignatureP = EddsaSignature
+end
+
+open Aliases
+
+let int32_size = 4
+let int64_size = 8
+
+module Bytes32 = struct
+ type t = string
+
+ let bin = Bin.bytes 32
+end
+
+module Bytes64 = struct
+ type t = string
+
+ let bin = Bin.bytes 64
+end
+
+module TransferSecretP = Bytes64
+module LinkSecretP = Bytes64
+module EncryptedLinkSecretP = Bytes64
+module BlindingMasterSeed = Bytes32
+module BlindingMasterSecret = Bytes32
+module WireTransferIdentifierRawP = Bytes32
+module PublicRefreshCoinNonceP = Bytes64
+module DenominationBlindingKeyP = Bytes32
+module RefreshCommitmentP = Bytes64
+
+module UUID = struct
+ type t = string
+
+ let size = 4 * int32_size
+ let bin = Bin.bytes size
+end
+
+module WadId = struct
+ type t = string
+
+ let size = 6 * int32_size
+ let bin = Bin.bytes size
+end
+
+module AgeMask = struct
+ type t = int32
+
+ let bin = Bin.beint32
+end
+
+(* --- *)
+
+(* EccSignaturePurpose *)
+module Purpose = struct
+ type t = {
+ size: int32;
+ purpose: int32;
+ }
+
+ let bin =
+ let open Bin in
+ record (fun size purpose -> { size; purpose })
+ |+ field beint32 (fun t -> t.size)
+ |+ field beint32 (fun t -> t.purpose)
+ |> sealr
+
+ let make ~size purpose = { size= Int32.of_int size; purpose }
+ let dummy = make ~size:0 0_l
+
+ (* helper function to make ['signature Bin.t]
+ to compute [t.size], we first build a bin with a dummy purpose *)
+ let make_bin =
+ let get_size f =
+ let open Bin in
+ match Size.of_value (Size.size_of (f dummy)) with
+ | Dynamic _ | Unknown ->
+ Fmt.failwith "size_of failure: size is not Static"
+ | Static n -> n
+ in
+ fun code f -> make ~size:(get_size f) code |> f
+
+ let field purpose = Bin.field bin (fun _t -> purpose)
+end
+
+(* --- Packed Signatures --- *)
+
+module MK (R : sig
+ type r
+
+ val bin : r Bin.t
+end) : sig
+ open Crypto
+
+ type r = R.r
+ type t
+
+ val sign_f : f:(string -> eddsa_sig) -> r -> t
+
+ val verify_f :
+ f:(eddsa_sig -> msg:string -> (unit, string) result) ->
+ t ->
+ r ->
+ (unit, string) result
+
+ val jsont : t Jsont.t
+ val caqti : t Caqti_type.t
+
+ (* TODO rm *)
+ (* escape hatch, only needed for /keys `exchange_sig` (signature over contatentation of all of the master_sigs) *)
+ val to_octets : t -> string
+end = struct
+ open Crypto
+
+ type r = R.r
+ type t = EddsaSignature.t
+
+ let sign_f ~f r = f (Bin.to_string R.bin r)
+ let verify_f ~f t r = f t ~msg:(Bin.to_string R.bin r)
+ let jsont = EddsaSignature.jsont
+ let caqti : EddsaSignature.t Caqti_type.t = EddsaSignature.caqti
+ let to_octets t = EddsaSignature.to_octets t
+end
+
+module DenominationKeyAnnouncement = struct
+ module R = struct
+ (* TODO CS: use purpose TALER_SIGNATURE_SM_CS_DENOMINATION_KEY *)
+ (* purpose.purpose = TALER_SIGNATURE_SM_RSA_DENOMINATION_KEY *)
+ type r = {
+ h_denom_pub: DenominationHash.t;
+ h_section_name: Hash.Cstring.H64.t;
+ anchor_time: TimestampNBO.t;
+ duration_withdraw: TimeRelativeNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.sm_rsa_denomination_key
+ @@ fun purpose ->
+ record
+ (fun
+ _purpose h_denom_pub h_section_name anchor_time duration_withdraw ->
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw })
+ |+ Purpose.field purpose
+ |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_section_name)
+ |+ field TimestampNBO.bin (fun t -> t.anchor_time)
+ |+ field TimeRelativeNBO.bin (fun t -> t.duration_withdraw)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module SigningKeyAnnouncement = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_SM_SIGNING_KEY *)
+ type r = {
+ exchange_pub: ExchangePublicKeyP.t;
+ anchor_time: TimestampNBO.t;
+ duration: TimeRelativeNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.sm_signing_key @@ fun purpose ->
+ record (fun _purpose exchange_pub anchor_time duration ->
+ { exchange_pub; anchor_time; duration })
+ |+ Purpose.field purpose
+ |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
+ |+ field TimestampNBO.bin (fun t -> t.anchor_time)
+ |+ field TimeRelativeNBO.bin (fun t -> t.duration)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module DenominationKeyValidity = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_VALIDITY *)
+ type r = {
+ master: MasterPublicKeyP.t;
+ start: TimestampNBO.t;
+ expire_withdraw: TimestampNBO.t;
+ expire_spend: TimestampNBO.t;
+ expire_legal: TimestampNBO.t;
+ value: AmountNBO.t;
+ fee_withdraw: AmountNBO.t;
+ fee_deposit: AmountNBO.t;
+ fee_refresh: AmountNBO.t;
+ (* TODO debug sig
+ missing field from taler doc *)
+ fee_refund: AmountNBO.t;
+ denom_hash: DenominationHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_denomination_key_validity
+ @@ fun purpose ->
+ record
+ (fun
+ _purpose
+ master
+ start
+ expire_withdraw
+ expire_spend
+ expire_legal
+ value
+ fee_withdraw
+ fee_deposit
+ fee_refresh
+ fee_refund
+ denom_hash
+ ->
+ {
+ master;
+ start;
+ expire_withdraw;
+ expire_spend;
+ expire_legal;
+ value;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_hash;
+ })
+ |+ Purpose.field purpose
+ |+ field MasterPublicKeyP.bin (fun t -> t.master)
+ |+ field TimestampNBO.bin (fun t -> t.start)
+ |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
+ |+ field TimestampNBO.bin (fun t -> t.expire_spend)
+ |+ field TimestampNBO.bin (fun t -> t.expire_legal)
+ |+ field AmountNBO.bin (fun t -> t.value)
+ |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
+ |+ field AmountNBO.bin (fun t -> t.fee_deposit)
+ |+ field AmountNBO.bin (fun t -> t.fee_refresh)
+ |+ field AmountNBO.bin (fun t -> t.fee_refund)
+ |+ field DenominationHash.bin (fun t -> t.denom_hash)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module ExchangeSigningKeyValidity = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_VALIDITY *)
+ type r = {
+ start: TimestampNBO.t;
+ expire: TimestampNBO.t;
+ end_: TimestampNBO.t;
+ signkey_pub: ExchangePublicKeyP.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_signing_key_validity
+ @@ fun purpose ->
+ record (fun _purpose start expire end_ signkey_pub ->
+ { start; expire; end_; signkey_pub })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.start)
+ |+ field TimestampNBO.bin (fun t -> t.expire)
+ |+ field TimestampNBO.bin (fun t -> t.end_)
+ |+ field ExchangePublicKeyP.bin (fun t -> t.signkey_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDenominationKeyRevocation = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DENOMINATION_KEY_REVOKED. *)
+ type r = { h_denom_pub: DenominationHash.t }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_denomination_key_revoked
+ @@ fun purpose ->
+ record (fun _purpose h_denom_pub -> { h_denom_pub })
+ |+ Purpose.field purpose
+ |+ field DenominationHash.bin (fun t -> t.h_denom_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterSigningKeyRevocation = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_SIGNING_KEY_REVOKED *)
+ type r = { exchange_pub: ExchangePublicKeyP.t }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_signing_key_revoked
+ @@ fun purpose ->
+ record (fun _purpose exchange_pub -> { exchange_pub })
+ |+ Purpose.field purpose
+ |+ field ExchangePublicKeyP.bin (fun t -> t.exchange_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterAddAuditor = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_AUDITOR *)
+ type r = {
+ start_date: TimestampNBO.t;
+ auditor_pub: AuditorPublicKeyP.t;
+ h_auditor_url: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_add_auditor @@ fun purpose ->
+ record (fun _purpose start_date auditor_pub h_auditor_url ->
+ { start_date; auditor_pub; h_auditor_url })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_auditor_url)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDelAuditor = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_AUDITOR *)
+ type r = {
+ end_date: TimestampNBO.t;
+ auditor_pub: AuditorPublicKeyP.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_del_auditor @@ fun purpose ->
+ record (fun _purpose end_date auditor_pub -> { end_date; auditor_pub })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field AuditorPublicKeyP.bin (fun t -> t.auditor_pub)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module GlobalFees = struct
+ module R = struct
+ (* TODO debug sig
+ taler doc *)
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_GLOBAL_FEES *)
+ type r = {
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ purse_timeout: TimeRelativeNBO.t;
+ history_expiration: TimeRelativeNBO.t;
+ history_fee: AmountNBO.t;
+ account_fee: AmountNBO.t;
+ purse_fee: AmountNBO.t;
+ purse_account_limit: int32;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_global_fees @@ fun purpose ->
+ record
+ (fun
+ _purpose
+ start_date
+ end_date
+ purse_timeout
+ history_expiration
+ history_fee
+ account_fee
+ purse_fee
+ purse_account_limit
+ ->
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ })
+ |+ Purpose.field purpose
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field TimeRelativeNBO.bin (fun t -> t.purse_timeout)
+ |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration)
+ |+ field AmountNBO.bin (fun t -> t.history_fee)
+ |+ field AmountNBO.bin (fun t -> t.account_fee)
+ |+ field AmountNBO.bin (fun t -> t.purse_fee)
+ |+ field beint32 (fun t -> t.purse_account_limit)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterWireDetails = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_DETAILS *)
+ type r = {
+ h_wire_details: FullPaytoHash.t;
+ h_conversion_url: Hash.Cstring.H64.t;
+ h_credit_restrictions: Hash.Cstring.H64.t;
+ h_debit_restrictions: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_wire_details @@ fun purpose ->
+ record
+ (fun
+ _purpose
+ h_wire_details
+ h_conversion_url
+ h_credit_restrictions
+ h_debit_restrictions
+ ->
+ {
+ h_wire_details;
+ h_conversion_url;
+ h_credit_restrictions;
+ h_debit_restrictions;
+ })
+ |+ Purpose.field purpose
+ |+ field FullPaytoHash.bin (fun t -> t.h_wire_details)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterAddWire = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_ADD_WIRE *)
+ type r = {
+ start_date: TimestampNBO.t;
+ h_wire: FullPaytoHash.t;
+ h_conversion_url: Hash.Cstring.H64.t;
+ h_credit_restrictions: Hash.Cstring.H64.t;
+ h_debit_restrictions: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_add_wire @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ start_date
+ h_wire
+ h_conversion_url
+ h_credit_restrictions
+ h_debit_restrictions
+ ->
+ {
+ start_date;
+ h_wire;
+ h_conversion_url;
+ h_credit_restrictions;
+ h_debit_restrictions;
+ })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field FullPaytoHash.bin (fun t -> t.h_wire)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_conversion_url)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_credit_restrictions)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_debit_restrictions)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDelWire = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DEL_WIRE *)
+ type r = {
+ end_date: TimestampNBO.t;
+ h_wire: FullPaytoHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_del_wire @@ fun _purpose ->
+ record (fun _purpose end_date h_wire -> { end_date; h_wire })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field FullPaytoHash.bin (fun t -> t.h_wire)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterDrainProfit = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_DRAIN_PROFITS *)
+ type r = {
+ wtid: WireTransferIdentifierRawP.t;
+ date: TimestampNBO.t;
+ amount: AmountNBO.t;
+ h_section: Hash.Cstring.H64.t;
+ h_payto: FullPaytoHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_drain_profit @@ fun _purpose ->
+ record (fun _purpose wtid date amount h_section h_payto ->
+ { wtid; date; amount; h_section; h_payto })
+ |+ Purpose.field _purpose
+ |+ field WireTransferIdentifierRawP.bin (fun t -> t.wtid)
+ |+ field TimestampNBO.bin (fun t -> t.date)
+ |+ field AmountNBO.bin (fun t -> t.amount)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_section)
+ |+ field FullPaytoHash.bin (fun t -> t.h_payto)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterAmlOfficerStatus = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_AML_KEY *)
+ type r = {
+ change_date: TimestampNBO.t;
+ officer_pub: AmlOfficerPublicKeyP.t;
+ h_officer_name: Hash.Cstring.H64.t;
+ is_active: int32;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_aml_key @@ fun _purpose ->
+ record (fun _purpose change_date officer_pub h_officer_name is_active ->
+ { change_date; officer_pub; h_officer_name; is_active })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.change_date)
+ |+ field AmlOfficerPublicKeyP.bin (fun t -> t.officer_pub)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_officer_name)
+ |+ field beint32 (fun t -> t.is_active)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module PartnerConfiguration = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_PARNTER_DETAILS *)
+ type r = {
+ partner_pub: MasterPublicKeyP.t;
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ wad_frequency: TimeRelativeNBO.t;
+ wad_fee: AmountNBO.t;
+ h_url: Hash.Cstring.H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_partner_details
+ @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ partner_pub
+ start_date
+ end_date
+ wad_frequency
+ wad_fee
+ h_url
+ -> { partner_pub; start_date; end_date; wad_frequency; wad_fee; h_url })
+ |+ Purpose.field _purpose
+ |+ field MasterPublicKeyP.bin (fun t -> t.partner_pub)
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
+ |+ field AmountNBO.bin (fun t -> t.wad_fee)
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_url)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module WadPartnerSignature = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_PARTNER_DETAILS *)
+ type r = {
+ h_partner_base_url: Hash.Cstring.H64.t;
+ master_public_key: MasterPublicKeyP.t;
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ wad_fee: AmountNBO.t;
+ wad_frequency: TimeRelativeNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_partner_details
+ @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ h_partner_base_url
+ master_public_key
+ start_date
+ end_date
+ wad_fee
+ wad_frequency
+ ->
+ {
+ h_partner_base_url;
+ master_public_key;
+ start_date;
+ end_date;
+ wad_fee;
+ wad_frequency;
+ })
+ |+ Purpose.field _purpose
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_partner_base_url)
+ |+ field MasterPublicKeyP.bin (fun t -> t.master_public_key)
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field AmountNBO.bin (fun t -> t.wad_fee)
+ |+ field TimeRelativeNBO.bin (fun t -> t.wad_frequency)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module MasterWireFee = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_MASTER_WIRE_FEES *)
+ type r = {
+ h_wire_method: Hash.Cstring.H64.t;
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ wire_fee: AmountNBO.t;
+ closing_fee: AmountNBO.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.master_wire_fees @@ fun _purpose ->
+ record
+ (fun _purpose h_wire_method start_date end_date wire_fee closing_fee ->
+ { h_wire_method; start_date; end_date; wire_fee; closing_fee })
+ |+ Purpose.field _purpose
+ |+ field Hash.Cstring.H64.bin (fun t -> t.h_wire_method)
+ |+ field TimestampNBO.bin (fun t -> t.start_date)
+ |+ field TimestampNBO.bin (fun t -> t.end_date)
+ |+ field AmountNBO.bin (fun t -> t.wire_fee)
+ |+ field AmountNBO.bin (fun t -> t.closing_fee)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module ExchangeKeyValidity = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_AUDITOR_EXCHANGE_KEYS *)
+ type r = {
+ auditor_url_hash: Hash.Cstring.H64.t;
+ master: MasterPublicKeyP.t;
+ start: TimestampNBO.t;
+ expire_withdraw: TimestampNBO.t;
+ expire_spend: TimestampNBO.t;
+ expire_legal: TimestampNBO.t;
+ value: AmountNBO.t;
+ fee_withdraw: AmountNBO.t;
+ fee_deposit: AmountNBO.t;
+ fee_refresh: AmountNBO.t;
+ denom_hash: DenominationHash.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.auditor_exchange_keys @@ fun _purpose ->
+ record
+ (fun
+ _purpose
+ auditor_url_hash
+ master
+ start
+ expire_withdraw
+ expire_spend
+ expire_legal
+ value
+ fee_withdraw
+ fee_deposit
+ fee_refresh
+ denom_hash
+ ->
+ {
+ auditor_url_hash;
+ master;
+ start;
+ expire_withdraw;
+ expire_spend;
+ expire_legal;
+ value;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ denom_hash;
+ })
+ |+ Purpose.field _purpose
+ |+ field Hash.Cstring.H64.bin (fun t -> t.auditor_url_hash)
+ |+ field MasterPublicKeyP.bin (fun t -> t.master)
+ |+ field TimestampNBO.bin (fun t -> t.start)
+ |+ field TimestampNBO.bin (fun t -> t.expire_withdraw)
+ |+ field TimestampNBO.bin (fun t -> t.expire_spend)
+ |+ field TimestampNBO.bin (fun t -> t.expire_legal)
+ |+ field AmountNBO.bin (fun t -> t.value)
+ |+ field AmountNBO.bin (fun t -> t.fee_withdraw)
+ |+ field AmountNBO.bin (fun t -> t.fee_deposit)
+ |+ field AmountNBO.bin (fun t -> t.fee_refresh)
+ |+ field DenominationHash.bin (fun t -> t.denom_hash)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+module ExchangeKeySet = struct
+ module R = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_KEY_SET *)
+ type r = {
+ list_issue_date: TimestampNBO.t;
+ (* hash over a concatenation of master_sigs *)
+ hc: H64.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.exchange_key_set @@ fun _purpose ->
+ record (fun _purpose list_issue_date hc -> { list_issue_date; hc })
+ |+ Purpose.field _purpose
+ |+ field TimestampNBO.bin (fun t -> t.list_issue_date)
+ |+ field H64.bin (fun t -> t.hc)
+ |> sealr
+ end
+
+ include R
+ include MK (R)
+end
+
+(* ### BIN IMPL END ### *)
+
+module WithdrawRequest = struct
+ (* Purpose is #TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
+ type t = {
+ amount: Amount.t;
+ fee: Amount.t;
+ h_planchets: HashPlanchetsP.t;
+ blinding_seed: BlindingMasterSecret.t;
+ max_age_group: int32;
+ mask: AgeMask.t;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.wallet_reserve_withdraw @@ fun purpose ->
+ record
+ (fun _purpose amount fee h_planchets blinding_seed max_age_group mask ->
+ { amount; fee; h_planchets; blinding_seed; max_age_group; mask })
+ |+ Purpose.field purpose
+ |+ field Amount.bin (fun t -> t.amount)
+ |+ field Amount.bin (fun t -> t.fee)
+ |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
+ |+ field BlindingMasterSecret.bin (fun t -> t.blinding_seed)
+ |+ field beint32 (fun t -> t.max_age_group)
+ |+ field AgeMask.bin (fun t -> t.mask)
+ |> sealr
+end
+
+module WithdrawConfirmation = struct
+ (* Purpose is #TALER_SIGNATURE_EXCHANGE_CONFIRM_WITHDRAW *)
+ type t = {
+ h_planchets: HashPlanchetsP.t;
+ noreveal_index: int32;
+ }
+
+ let bin =
+ let open Bin in
+ Purpose.make_bin Taler_signatures.exchange_confirm_withdraw
+ @@ fun purpose ->
+ record (fun _purpose h_planchets noreveal_index ->
+ { h_planchets; noreveal_index })
+ |+ Purpose.field purpose
+ |+ field HashPlanchetsP.bin (fun t -> t.h_planchets)
+ |+ field beint32 (fun t -> t.noreveal_index)
+ |> sealr
+end
+
+module SingleWithdrawRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_WITHDRAW *)
+ type t = {
+ amount_with_fee: AmountNBO.t;
+ h_denomination_pub: DenominationHash.t;
+ h_coin_envelope: BlindedCoinHash.t;
+ }
+end
+
+module DepositRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_DEPOSIT *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_age_commitment: AgeCommitmentHash.t;
+ h_policy: ExtensionsPolicyHash.t;
+ h_wire: MerchantWireHash.t;
+ h_denom_pub: DenominationHash.t;
+ timestamp: TimestampNBO.t;
+ refund_deadline: TimestampNBO.t;
+ amount_with_fee: AmountNBO.t;
+ deposit_fee: AmountNBO.t;
+ merchant: MerchantPublicKeyP.t;
+ wallet_data_hash: Hash.Cstring.H64.t;
+ }
+end
+
+module DepositConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_DEPOSIT *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: MerchantWireHash.t;
+ h_policy: ExtensionsPolicyHash.t;
+ timestamp: TimestampNBO.t;
+ refund_deadline: TimestampNBO.t;
+ amount_without_fee: AmountNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ merchant: MerchantPublicKeyP.t;
+ }
+end
+
+module RefreshMeltCoinAffirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_MELT *)
+ type t = {
+ session_hash: RefreshCommitmentP.t;
+ h_denom_pub: DenominationHash.t;
+ h_age_commitment: AgeCommitmentHash.t;
+ amount_with_fee: AmountNBO.t;
+ melt_fee: AmountNBO.t;
+ }
+end
+
+module RefreshMeltConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_MELT *)
+ type t = {
+ session_hash: RefreshCommitmentP.t;
+ noreveal_index: int; (* uint16_t mapped to OCaml int *)
+ }
+end
+
+module DepositTrack = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: MerchantWireHash.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ }
+end
+
+module WireDepositDetailP = struct
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ execution_time: TimestampNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ deposit_value: AmountNBO.t;
+ deposit_fee: AmountNBO.t;
+ }
+end
+
+module WireDepositData = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE_DEPOSIT *)
+ type t = {
+ total: AmountNBO.t;
+ wire_fee: AmountNBO.t;
+ merchant_pub: MerchantPublicKeyP.t;
+ h_wire: MerchantWireHash.t;
+ h_details: Hash.Cstring.H64.t;
+ }
+end
+
+module PaymentResponse = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_PAYMENT_OK *)
+ type t = { h_contract_terms: PrivateContractHash.t }
+end
+
+module Contract = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_CONTRACT *)
+ type t = { h_contract_terms: PrivateContractHash.t }
+end
+
+module ConfirmWire = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_WIRE *)
+ type t = {
+ h_wire: MerchantWireHash.t;
+ h_contract_terms: PrivateContractHash.t;
+ wtid: WireTransferIdentifierRawP.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ execution_time: TimestampNBO.t;
+ coin_contribution: AmountNBO.t;
+ }
+end
+
+module RefundConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_REFUND *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ merchant: MerchantPublicKeyP.t;
+ rtransaction_id: int64;
+ refund_amount: AmountNBO.t;
+ }
+end
+
+module DepositTrackPS2 = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_TRACK_TRANSACTION *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: MerchantWireHash.t;
+ merchant: MerchantPublicKeyP.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ }
+end
+
+module RefundRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND *)
+ type t = {
+ h_contract_terms: PrivateContractHash.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ rtransaction_id: int64;
+ refund_amount: AmountNBO.t;
+ refund_fee: AmountNBO.t;
+ }
+end
+
+module MerchantRefundConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_MERCHANT_REFUND_OK *)
+ (* Hash of the order ID (a string), hashed without the 0-termination. *)
+ type t = { h_order_id: Hash.Cstring.H64.t }
+end
+
+module RecoupRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_RECOUP or TALER_SIGNATURE_WALLET_COIN_RECOUP_REFRESH *)
+ type t = {
+ h_denom_pub: DenominationHash.t;
+ coin_blind: DenominationBlindingKeyP.t;
+ }
+end
+
+module RecoupRefreshConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP_REFRESH *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ recoup_amount: AmountNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ old_coin_pub: CoinSpendPublicKeyP.t;
+ }
+end
+
+module RecoupConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_RECOUP *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ recoup_amount: AmountNBO.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ reserve_pub: ReservePublicKeyP.t;
+ }
+end
+
+module DenominationUnknownAffirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_AFFIRM_DENOM_UNKNOWN *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ h_denom_pub: DenominationHash.t;
+ }
+end
+
+module DenominationExpiredAffirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_GENERIC_DENOMINATIN_EXPIRED *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ operation: string; (* char[8] → string *)
+ h_denom_pub: DenominationHash.t;
+ }
+end
+
+module ReserveCloseConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_CLOSED *)
+ type t = {
+ timestamp: TimestampNBO.t;
+ closing_amount: AmountNBO.t;
+ reserve_pub: ReservePublicKeyP.t;
+ h_wire: FullPaytoHash.t;
+ }
+end
+
+module CoinLinkSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
+ type t = {
+ h_denom_pub: DenominationHash.t;
+ old_coin_pub: CoinSpendPublicKeyP.t;
+ transfer_pub: TransferPublicKeyP.t;
+ coin_envelope_hash: BlindedCoinHash.t;
+ }
+end
+
+module RefreshNonceSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_COIN_LINK *)
+ type t = { nonce: PublicRefreshCoinNonceP.t }
+end
+
+module ReserveStatusRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_RESERVE_STATUS_REQUEST *)
+ type t = { request_timestamp: TimestampNBO.t }
+end
+
+module ReserveHistoryRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_RESERVE_HISTORY_REQUEST *)
+ type t = {
+ history_fee: AmountNBO.t;
+ request_timestamp: TimestampNBO.t;
+ }
+end
+
+module PurseStatusRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_REQUEST *)
+ type t = unit
+end
+
+module PurseStatusResponseSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_STATUS_RESPONSE *)
+ type t = {
+ total_purse_amount: AmountNBO.t;
+ total_deposit_amount: AmountNBO.t;
+ max_deposit_fees: AmountNBO.t;
+ purse_expiration: TimestampNBO.t;
+ status_timestamp: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ }
+end
+
+module ReserveCloseRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
+ type t = unit
+end
+
+module PurseRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_CREATE *)
+ type t = {
+ purse_expiration: TimestampNBO.t;
+ merge_value_after_fees: AmountNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ min_age: int;
+ }
+end
+
+module PurseDepositSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT *)
+ type t = {
+ coin_contribution: AmountNBO.t;
+ h_denom_pub: DenominationHash.t;
+ h_age_commitment: AgeCommitmentHash.t;
+ purse_pub: PursePublicKey.t;
+ h_exchange_base_url: Hash.Cstring.H64.t;
+ }
+end
+
+module PurseDepositSignaturePS2 = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN_DEPOSIT *)
+ type t = {
+ reserve_sig: ReserveSignatureP.t;
+ coin_contribution: AmountNBO.t;
+ }
+end
+
+module PurseDepositConfirmedSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_DEPOSIT_CONFIRMED *)
+ type t = {
+ total_purse_amount: AmountNBO.t;
+ total_deposit_fees: AmountNBO.t;
+ purse_pub: PursePublicKey.t;
+ purse_expiration: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ }
+end
+
+module PurseMergeSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_PURSE_MERGE *)
+ type t = {
+ merge_timestamp: TimestampNBO.t;
+ h_wire: NormalizedPaytoHash.t;
+ }
+end
+
+module AccountMergeSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_MERGE *)
+ type t = {
+ reserve_pub: ReservePublicKeyP.t;
+ purse_pub: PursePublicKey.t;
+ merge_amount_after_fees: AmountNBO.t;
+ merge_timestamp: TimestampNBO.t;
+ purse_expiration: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ min_age: int;
+ }
+end
+
+module AccountSetupRequestSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_ACCOUNT_SETUP *)
+ type t = { threshold: AmountNBO.t }
+end
+
+module PurseMergeSuccessSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_PURSE_MERGE_SUCCESS *)
+ type t = {
+ reserve_pub: ReservePublicKeyP.t;
+ purse_pub: PursePublicKey.t;
+ merge_amount_after_fees: AmountNBO.t;
+ contract_time: TimestampNBO.t;
+ h_contract_terms: PrivateContractHash.t;
+ h_wire: NormalizedPaytoHash.t;
+ min_age: int;
+ }
+end
+
+module WadDataSignature = struct
+ (* purpose.purpose = TALER_SIGNATURE_WAD_DATA *)
+ type t = {
+ wad_execution_time: TimestampNBO.t;
+ total_amount: AmountNBO.t;
+ h_items: Hash.Cstring.H64.t;
+ wad_id: WadId.t;
+ }
+end
+
+module P2PFees = struct
+ (* purpose.purpose = TALER_SIGNATURE_P2P_FEES *)
+ type t = {
+ start_date: TimestampNBO.t;
+ end_date: TimestampNBO.t;
+ kyc_fee: AmountNBO.t;
+ purse_fee: AmountNBO.t;
+ account_history_fee: AmountNBO.t;
+ account_annual_fee: AmountNBO.t;
+ account_kyc_timeout: TimeRelativeNBO.t;
+ purse_timeout: TimeRelativeNBO.t;
+ purse_account_limit: int;
+ }
+end
+
+module CoinPurseRefundConfirmation = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_CONFIRM_PURSE_REFUND *)
+ type t = {
+ purse_pub: PursePublicKey.t;
+ coin_pub: CoinSpendPublicKeyP.t;
+ refunded_amount: AmountNBO.t;
+ refund_fee: AmountNBO.t;
+ }
+end
+
+module AmlDecision = struct
+ (* purpose.purpose = TALER_SIGNATURE_AML_DECISION *)
+ type t = {
+ h_justification: Hash.Cstring.H64.t;
+ decision_time: TimestampNBO.t;
+ new_threshold: AmountNBO.t;
+ h_payto: NormalizedPaytoHash.t;
+ h_kyc_requirements: Hash.Cstring.H64.t;
+ new_state: int;
+ }
+end
+
+module ReserveOpen = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_OPEN *)
+ type t = {
+ reserve_payment: AmountNBO.t;
+ request_timestamp: TimestampNBO.t;
+ reserve_expiration: TimestampNBO.t;
+ purse_limit: int;
+ }
+end
+
+module ReserveClose = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_RESERVE_CLOSE *)
+ type t = {
+ request_timestamp: TimestampNBO.t;
+ target_account_h_payto: FullPaytoHash.t;
+ }
+end
+
+module ReserveAttestRequest = struct
+ (* purpose.purpose = TALER_SIGNATURE_WALLET_ATTEST_REQUEST *)
+ type t = {
+ request_timestamp: TimestampNBO.t;
+ h_details: Hash.Cstring.H64.t;
+ }
+end
+
+module ExchangeAttest = struct
+ (* purpose.purpose = TALER_SIGNATURE_EXCHANGE_RESERVE_ATTEST_DETAILS *)
+ type t = {
+ attest_timestamp: TimestampNBO.t;
+ expiration_time: TimestampNBO.t;
+ reserve_pub: ReservePublicKeyP.t;
+ h_attributes: Hash.Cstring.H64.t;
+ }
+end
diff --git a/.jjconflict-side-1/src/signkey_data.ml b/.jjconflict-side-1/src/signkey_data.ml
new file mode 100644
index 00000000..22a7a0cd
--- /dev/null
+++ b/.jjconflict-side-1/src/signkey_data.ml
@@ -0,0 +1,10 @@
+open Crypto
+
+type t = {
+ pub: eddsa_pub;
+ stamp_start: Timestamp.t;
+ stamp_expire: Timestamp.t;
+ stamp_end: Timestamp.t;
+ master_sig: Signatures.ExchangeSigningKeyValidity.t option;
+ revoked_sig: Signatures.MasterSigningKeyRevocation.t option;
+}
diff --git a/.jjconflict-side-1/src/static.ml b/.jjconflict-side-1/src/static.ml
new file mode 100644
index 00000000..5706022c
--- /dev/null
+++ b/.jjconflict-side-1/src/static.ml
@@ -0,0 +1,79 @@
+(* /terms + /privacy *)
+
+(* TODO response *)
+module Respond_with = struct
+ open Vif.Response
+ open Syntax
+
+ open struct
+ let error_detail ?hint _status =
+ let open Api in
+ let code = -1 in
+ let err = ErrorDetail.make ?hint code in
+ let s = encode_exn ErrorDetail.jsont err in
+ Logs.err (fun m -> m "ErrorDetail: `%s`" s);
+ s
+ end
+
+ let bad_request ?hint req =
+ let body = error_detail ?hint `Bad_request in
+ let* () = add ~field:"content-type" "application/json" in
+ let* () = with_string ?compression:None req body in
+ respond `Bad_request
+
+ let not_modified () =
+ let* () = empty in
+ respond `Not_modified
+end
+
+let aux asset req _server _env =
+ let etag = Assets.etag asset in
+ let headers = Vif.Request.headers req in
+ let has_matching_etag =
+ match Vif.Headers.get headers "if-none-match" with
+ | None -> Ok false
+ | Some s ->
+ Headers_lib.If_none_match.parse s
+ |> Result.map (Headers_lib.If_none_match.evaluate etag)
+ in
+ match has_matching_etag with
+ | Error e ->
+ Logs.err (fun m -> m "bad request");
+ Respond_with.bad_request ~hint:e req
+ | Ok true ->
+ Logs.err (fun m -> m "not modified");
+ Respond_with.not_modified ()
+ | Ok false ->
+ let mime = Headers.select_mimetype headers in
+ let lang = Headers.select_language headers in
+ let compression = Headers.select_encoding headers in
+ let data = Assets.get_content ~mime ~lang asset in
+ (* -- *)
+ let open Vif.Response in
+ let open Syntax in
+ let* () = with_string ?compression req data in
+ let* () =
+ let etag_field_value = Headers_lib.Etag.to_field_string etag in
+ add ~field:"etag" etag_field_value
+ in
+ let* () =
+ add ~field:"taler-terms-version"
+ Assets.Assets_config.terms_legal_version
+ in
+ let* () =
+ add ~field:"avail-languages" Headers.avail_languages_header_value
+ in
+ let* () =
+ let content_type = Fmt.str "%a" Assets.Mimetype.pp mime in
+ add ~field:"content-type" content_type
+ in
+ let* () = add ~field:"content-language" lang in
+ respond `OK
+
+let terms req _server _env =
+ Logs.info (fun m -> m "GET /terms");
+ aux Assets.Terms req _server _env
+
+let privacy req _server _env =
+ Logs.info (fun m -> m "GET /privacy");
+ aux Assets.Privacy req _server _env
diff --git a/.jjconflict-side-1/src/syntax.ml b/.jjconflict-side-1/src/syntax.ml
new file mode 100644
index 00000000..c61aba15
--- /dev/null
+++ b/.jjconflict-side-1/src/syntax.ml
@@ -0,0 +1,51 @@
+let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
+let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e
+
+(* TODO use polymorphic variant for errors *)
+let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v
+
+let unwrap_err_caqti o =
+ match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v
+
+let list_iter f l =
+ let err = ref None in
+ try
+ List.iter
+ (fun v ->
+ match f v with
+ | Error _e as e ->
+ err := Some e;
+ raise Exit
+ | Ok () -> ())
+ l;
+ Ok ()
+ with Exit -> ( match !err with None -> assert false | Some v -> v)
+
+let list_map f l =
+ let err = ref None in
+ try
+ Ok
+ (List.map
+ (fun v ->
+ match f v with
+ | Error _e as e ->
+ err := Some e;
+ raise Exit
+ | Ok v -> v)
+ l)
+ with Exit -> ( match !err with None -> assert false | Some v -> v)
+
+let list_fold_left f acc l =
+ List.fold_left
+ (fun acc v ->
+ let* acc = acc in
+ f acc v)
+ (Ok acc) l
+
+let opt_list l =
+ match (List.for_all Option.is_none l, List.for_all Option.is_some l) with
+ | _, true ->
+ let l = List.map Option.get l in
+ Ok (Some l)
+ | true, _ -> Ok None
+ | _, _ -> Error ()
diff --git a/.jjconflict-side-1/src/taler_signatures.ml b/.jjconflict-side-1/src/taler_signatures.ml
new file mode 100644
index 00000000..8715b472
--- /dev/null
+++ b/.jjconflict-side-1/src/taler_signatures.ml
@@ -0,0 +1,280 @@
+(* This file was generated from the GANA database:
+ https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)
+
+(** Initialize or update the status of an AML key for an AML officer *)
+let master_aml_key : int32 = 1017_l
+
+(** Affirm wiring of exchange profits to operator account. *)
+let master_drain_profit : int32 = 1018_l
+
+(** Signature affirming a partner configuration for wads. *)
+let master_partner_details : int32 = 1019_l
+
+(** The given revocation key was revoked and must no longer be used. *)
+let master_signing_key_revoked : int32 = 1020_l
+
+(** Add payto URI to the list of our wire methods. *)
+let master_add_wire : int32 = 1021_l
+
+(** Signature over global set of fees charged by the exchange. *)
+let master_global_fees : int32 = 1022_l
+
+(** Remove payto URI from the list of our wire methods. *)
+let master_del_wire : int32 = 1023_l
+
+(** Purpose for signing public keys signed by the exchange master key. *)
+let master_signing_key_validity : int32 = 1024_l
+
+(** Purpose for denomination keys signed by the exchange master key. *)
+let master_denomination_key_validity : int32 = 1025_l
+
+(** Add an auditor to the list of our auditors. *)
+let master_add_auditor : int32 = 1026_l
+
+(** Remove an auditor from the list of our auditors. *)
+let master_del_auditor : int32 = 1027_l
+
+(** Fees charged per (aggregate) wire transfer to the merchant. *)
+let master_wire_fees : int32 = 1028_l
+
+(** The given revocation key was revoked and must no longer be used. *)
+let master_denomination_key_revoked : int32 = 1029_l
+
+(** Signature where the Exchange confirms its IBAN details in the /wire
+ response. *)
+let master_wire_details : int32 = 1030_l
+
+(** Set the configuration of an extension (age-restriction or peer2peer) *)
+let master_extension : int32 = 1031_l
+
+(** Purpose for the state of a reserve, signed by the exchange's signing key. *)
+let exchange_reserve_status : int32 = 1032_l
+
+(** Signature where the Exchange confirms a deposit request. *)
+let exchange_confirm_deposit : int32 = 1033_l
+
+(** Signature where the exchange (current signing key) confirms the no-reveal
+ index for cut-and-choose and the validity of the melted coins. *)
+let exchange_confirm_melt : int32 = 1034_l
+
+(** Signature where the Exchange confirms the full /keys response set. *)
+let exchange_key_set : int32 = 1035_l
+
+(** Signature where the Exchange confirms the /track/transaction response. *)
+let exchange_confirm_wire : int32 = 1036_l
+
+(** Signature where the Exchange confirms the /wire/deposit response. *)
+let exchange_confirm_wire_deposit : int32 = 1037_l
+
+(** Signature where the Exchange confirms a refund request. *)
+let exchange_confirm_refund : int32 = 1038_l
+
+(** Signature where the Exchange confirms a recoup. *)
+let exchange_confirm_recoup : int32 = 1039_l
+
+(** Signature where the Exchange confirms it closed a reserve. *)
+let exchange_reserve_closed : int32 = 1040_l
+
+(** Signature where the Exchange confirms a recoup-refresh operation. *)
+let exchange_confirm_recoup_refresh : int32 = 1041_l
+
+(** Signature where the Exchange confirms that it does not know a denomination
+ (hash). *)
+let exchange_affirm_denom_unknown : int32 = 1042_l
+
+(** Signature where the Exchange confirms that it does not consider a
+ denomination valid for the given operation at this time. *)
+let exchange_affirm_denom_expired : int32 = 1043_l
+
+(** Signature by which the exchange affirms that a purse was created with a
+ certain amount deposited into it. *)
+let exchange_confirm_purse_creation : int32 = 1045_l
+
+(** Signature by which the exchange affirms that a purse was merged into a
+ reserve with a certain amount in it. *)
+let exchange_confirm_purse_merged : int32 = 1046_l
+
+(** Purpose for the state of a purse, signed by the exchange's signing key. *)
+let exchange_purse_status : int32 = 1047_l
+
+(** Signature by which the exchange attests identity attributes of a particular
+ reserve owner. *)
+let exchange_reserve_attest_details : int32 = 1048_l
+
+(** Signature by which the exchange confirms that a purse expired and a coin was
+ refunded. *)
+let exchange_confirm_purse_refund : int32 = 1049_l
+
+(** Signature where the Exchange confirms an (age-)withdraw. *)
+let exchange_confirm_withdraw : int32 = 1050_l
+
+(** Signature where the auditor confirms that he is aware of certain
+ denomination keys from the exchange. *)
+let auditor_exchange_keys : int32 = 1064_l
+
+(** Signature where the merchant confirms a contract (to the customer). *)
+let merchant_contract : int32 = 1101_l
+
+(** Signature where the merchant confirms a refund (of a coin). *)
+let merchant_refund : int32 = 1102_l
+
+(** Signature where the merchant confirms that he needs the wire transfer
+ identifier for a deposit operation. *)
+let merchant_track_transaction : int32 = 1103_l
+
+(** Signature where the merchant confirms that the payment was successful *)
+let merchant_payment_ok : int32 = 1104_l
+
+(** Signature where the merchant confirms its own (salted) wire details (not yet
+ really used). *)
+let merchant_wire_details : int32 = 1107_l
+
+(** Signature where the merchant issues a token by blindly signing it. Signed
+ with the token issue private key. *)
+let merchant_token_issue : int32 = 1108_l
+
+(** Signature where the reserve key confirms a withdraw request. Signed with the
+ reserve private key. *)
+let wallet_reserve_withdraw : int32 = 1200_l
+
+(** Signature made by the wallet of a user to confirm a deposit of a coin. *)
+let wallet_coin_deposit : int32 = 1201_l
+
+(** Signature using a coin key confirming the melting of a coin. Signed with the
+ coin's private key. *)
+let wallet_coin_melt : int32 = 1202_l
+
+(** Signature using a coin key requesting recoup. Signed with the coin's private
+ key. *)
+let wallet_coin_recoup : int32 = 1203_l
+
+(** Signature using a coin key authenticating link data. Signed with the old
+ coin's private key. *)
+let wallet_coin_link : int32 = 1204_l
+
+(** Signature using a reserve key by which a wallet requests a payment target
+ UUID for itself. Signs over just a purpose (no body), as the signature only
+ serves to demonstrate that the request comes from the wallet controlling the
+ private key, and not some third party. *)
+let wallet_account_setup : int32 = 1205_l
+
+(** Signature using a coin key requesting recoup-refresh. Signed with the coin
+ private key. *)
+let wallet_coin_recoup_refresh : int32 = 1206_l
+
+(** Signature using a age restriction key for attestation of a particular
+ age/age-group. *)
+let wallet_age_attestation : int32 = 1207_l
+
+(** Request full or partial reserve history. Signed with the reserve private
+ key. *)
+let wallet_reserve_history : int32 = 1208_l
+
+(** Request full or partial coin history. Signed with the coin private key. *)
+let wallet_coin_history : int32 = 1209_l
+
+(** Request purse creation (without reserve). Signed by the purse private key.
+*)
+let wallet_purse_create : int32 = 1210_l
+
+(** Request coin to be deposited into a purse. Signed with the coin private key.
+*)
+let wallet_purse_deposit : int32 = 1211_l
+
+(** Request purse status. Signed with the purse private key. *)
+let wallet_purse_status : int32 = 1212_l
+
+(** Request purse to be merged with a reserve. Signed with the purse private
+ key. *)
+let wallet_purse_merge : int32 = 1213_l
+
+(** Request purse to be merged with a reserve. Signed by the reserve private
+ key. *)
+let wallet_account_merge : int32 = 1214_l
+
+(** Request account to be closed. Signed with the reserve private key. *)
+let wallet_reserve_close : int32 = 1215_l
+
+(** Associates encrypted contract with a purse. Signed with the purse private
+ key. *)
+let wallet_purse_econtract : int32 = 1216_l
+
+(** Request reserve to be kept open. Signed with the reserve private key. *)
+let wallet_reserve_open : int32 = 1217_l
+
+(** Request coin to be used to pay for reserve to be kept open. Signed with the
+ coin private key. *)
+let wallet_reserve_open_deposit : int32 = 1218_l
+
+(** Request attestation about reserve owner. Signed by the reserve private key.
+*)
+let wallet_reserve_attest_details : int32 = 1219_l
+
+(** Signature by which a wallet requests a purse to be deleted. *)
+let wallet_purse_delete : int32 = 1220_l
+
+(** Signature where the reserve key confirms an age-withdraw request. Signed
+ with the reserve private key. *)
+let wallet_reserve_age_withdraw : int32 = 1221_l
+
+(** Signature where the token use key confirms the usage of a token on a pay
+ request. Signed with the token use private key. *)
+let wallet_token_use : int32 = 1222_l
+
+(** Signature used to unclaim an order, allowing other wallets to claim it.
+ Signed with the private key of the claim nonce. *)
+let wallet_order_unclaim : int32 = 1223_l
+
+(** Signature on a denomination key announcement. *)
+let sm_rsa_denomination_key : int32 = 1250_l
+
+(** Signature on an exchange message signing key announcement. *)
+let sm_signing_key : int32 = 1251_l
+
+(** Signature on a denomination key announcement. *)
+let sm_cs_denomination_key : int32 = 1252_l
+
+(** EdDSA test signature. *)
+let client_test_eddsa : int32 = 1302_l
+
+(** EdDSA test signature. *)
+let exchange_test_eddsa : int32 = 1303_l
+
+(** Signature by which an AML officer signs an AML decision. *)
+let aml_decision : int32 = 1350_l
+
+(** Signature by which an AML officer requests AML data. *)
+let aml_query : int32 = 1351_l
+
+(** Signature by which an account owner authorizes access to a KYC operation. *)
+let kyc_auth : int32 = 1360_l
+
+(** EdDSA signature for a policy upload. *)
+let anastasis_policy_upload : int32 = 1400_l
+
+(** EdDSA signature for a backup upload. *)
+let sync_backup_upload : int32 = 1450_l
+
+(** The signature is done by the Donau. The Donau signes over the total amount
+ of the corresponding year, the corresponding year and the donation
+ identifier of a specific donor. The statement confirms that the donor made
+ this total in donations for the given year. *)
+let donau_donation_statement : int32 = 1500_l
+
+(** The signature is made by a charity and shows that the charity is in
+ agreement with the donation request which it sends to the Donau. The charity
+ signs over all blinded identifiers and key pairs which it has received from
+ the donor. The signature affirms that the charity wants the donation
+ receipts to be issued on its behalf. *)
+let charity_donation_confirmation : int32 = 1501_l
+
+(** The signature is made by a charity to request information about its status
+ from a Donau. It is not over anything in particular and is just there for
+ access control. *)
+let charity_get_info : int32 = 1502_l
+
+(** Signature over messages to delete in the mailbox service *)
+let mailbox_messages_delete : int32 = 1551_l
+
+(** Signature for mailbox registration request *)
+let mailbox_register : int32 = 1552_l
diff --git a/.jjconflict-side-1/src/time.ml b/.jjconflict-side-1/src/time.ml
new file mode 100644
index 00000000..3c5af371
--- /dev/null
+++ b/.jjconflict-side-1/src/time.ml
@@ -0,0 +1,151 @@
+let uint64_max = Int64.minus_one
+
+module Relative = struct
+ type t = Int64.t
+
+ let forever = uint64_max
+ let zero = 0L
+ let compare = Int64.unsigned_compare
+ let min a b = if compare a b < 0 then a else b
+ let max a b = if compare a b > 0 then a else b
+
+ (* forever if either argument is forever or on overflow; otherwise a + b *)
+ let add a b =
+ if a = forever || b = forever then forever
+ else
+ let v = Int64.add a b in
+ if compare v a < 0 then forever else v
+
+ (* zero if a <= b, or forever if a is forever; otherwise a - b *)
+ let sub a b =
+ if compare a b <= 0 then zero
+ else if a = forever then forever
+ else Int64.sub a b
+
+ let of_s s =
+ let v = Int64.mul s 1_000_000L in
+ if Int64.unsigned_div v 1_000_000L <> s then forever else v
+
+ let bin = Bin.neint64
+ let bin_nbo = Bin.beint64
+
+ (* TODO should be in NBO here? *)
+ let caqti =
+ let encode v = Ok v in
+ let decode v = Ok v in
+ Caqti_type.custom ~encode ~decode Caqti_type.int64
+
+ (* TODO
+ reject negative / non-integer values
+ cap value at 2^53 - 1 inclusive *)
+ let jsont =
+ let jsont =
+ let forever_jsont =
+ let dec s =
+ match s with
+ | "forever" -> forever
+ | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
+ in
+ let enc _t = "forever" in
+ Jsont.map ~dec ~enc Jsont.string
+ in
+ let num_jsont = Jsont.int64 in
+ let enc t = if t = forever then forever_jsont else num_jsont in
+ Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc ()
+ in
+ Jsont.Object.map ~kind:"RelativeTime" Fun.id
+ |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id
+ |> Jsont.Object.finish
+end
+
+module Absolute = struct
+ type t = Int64.t
+
+ let never = uint64_max
+ let zero = 0L
+ let compare = Int64.unsigned_compare
+ let min a b = if compare a b < 0 then a else b
+ let max a b = if compare a b > 0 then a else b
+
+ (* zero if a >= b; never if b=never; otherwise b - a *)
+ let diff a b =
+ if compare a b >= 0 then zero
+ else if b = never then never
+ else Int64.sub b a
+
+ (* never if either argument is never/forever or on overflow; otherwise t + d *)
+ let add t d =
+ if t = never || d = never then never
+ else
+ let v = Int64.add t d in
+ if compare v t < 0 then never else v
+
+ (* zero if t <= d, or never if t is never; otherwise t - d *)
+ let sub t d =
+ if compare t d <= 0 then zero
+ else if t = never then never
+ else Int64.sub t d
+
+ let of_s s =
+ let v = Int64.mul s 1_000_000L in
+ if Int64.unsigned_div v 1_000_000L <> s then never else v
+
+ let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s
+end
+
+module Timestamp = struct
+ type t = Int64.t
+
+ let never = uint64_max
+ let zero = 0L
+ let compare = Int64.unsigned_compare
+
+ (* zero if a >= b; never if b=never; otherwise b - a *)
+ let diff a b =
+ if compare a b >= 0 then zero
+ else if b = never then never
+ else Int64.sub b a
+
+ let of_s s =
+ let v = Int64.mul s 1_000_000L in
+ if Int64.unsigned_div v 1_000_000L <> s then never else v
+
+ let to_s t =
+ if t = never then None else Some (Int64.unsigned_div t 1_000_000L)
+
+ let of_absolute a =
+ if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L)
+
+ let of_ptime v = v |> Absolute.of_ptime |> of_absolute
+ let bin = Bin.neint64
+ let bin_nbo = Bin.beint64
+
+ let caqti =
+ let encode v = Ok v in
+ let decode v = Ok v in
+ Caqti_type.custom ~encode ~decode Caqti_type.int64
+
+ let jsont =
+ let jsont =
+ let never_jsont =
+ let dec s =
+ match s with
+ | "never" -> never
+ | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
+ in
+ let enc _t = "never" in
+ Jsont.map ~dec ~enc Jsont.string
+ in
+ let num_jsont =
+ Jsont.map
+ ~dec:(fun n -> of_s n)
+ ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s)
+ Jsont.int64
+ in
+ let enc t = if t = never then never_jsont else num_jsont in
+ Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc ()
+ in
+ Jsont.Object.map ~kind:"Timestamp" Fun.id
+ |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id
+ |> Jsont.Object.finish
+end
diff --git a/.jjconflict-side-1/src/time.mli b/.jjconflict-side-1/src/time.mli
new file mode 100644
index 00000000..180df904
--- /dev/null
+++ b/.jjconflict-side-1/src/time.mli
@@ -0,0 +1,54 @@
+module Relative : sig
+ type t
+
+ val forever : t
+ val zero : t
+ val compare : t -> t -> int
+ val min : t -> t -> t
+ val max : t -> t -> t
+ val add : t -> t -> t
+ val sub : t -> t -> t
+ val of_s : int64 -> t
+
+ (* - *)
+ val bin : t Bin.t
+ val bin_nbo : t Bin.t
+ val caqti : t Caqti_type.t
+ val jsont : t Jsont.t
+end
+
+module Absolute : sig
+ type t
+
+ val never : t
+ val zero : t
+ val compare : t -> t -> int
+ val min : t -> t -> t
+ val max : t -> t -> t
+ val diff : t -> t -> Relative.t
+ val add : t -> Relative.t -> t
+ val sub : t -> Relative.t -> t
+ val of_s : int64 -> t
+ val of_ptime : Ptime.t -> t
+end
+
+module Timestamp : sig
+ type t
+
+ val never : t
+ val zero : t
+ val compare : t -> t -> int
+ val diff : t -> t -> Relative.t
+ val of_s : int64 -> t
+
+ (* none if t = never *)
+ val to_s : t -> int64 option
+ val of_absolute : Absolute.t -> t
+ val of_ptime : Ptime.t -> t
+
+ (* - *)
+ val bin : t Bin.t
+ val bin_nbo : t Bin.t
+ val caqti : t Caqti_type.t
+ val jsont : t Jsont.t
+end
diff --git a/.jjconflict-side-1/src/timestamp.ml b/.jjconflict-side-1/src/timestamp.ml
new file mode 100644
index 00000000..1a942758
--- /dev/null
+++ b/.jjconflict-side-1/src/timestamp.ml
@@ -0,0 +1 @@
+include Time.Timestamp
diff --git a/.jjconflict-side-1/src/util.ml b/.jjconflict-side-1/src/util.ml
new file mode 100644
index 00000000..c690a009
--- /dev/null
+++ b/.jjconflict-side-1/src/util.ml
@@ -0,0 +1,62 @@
+module Log_reporter = struct
+ let detail_tag : string Logs.Tag.def =
+ Logs.Tag.def "Detail tag" ~doc:"" Fmt.string
+
+ let detail s = Logs.Tag.(empty |> add detail_tag s)
+ let time_anchor = Ptime_clock.now () |> Ptime.to_span
+
+ let color_of_log_level = function
+ | Logs.App -> `White
+ | Error -> `Red
+ | Warning -> `Yellow
+ | Info -> `Blue
+ | Debug -> `Magenta
+
+ let reporter : Logs.reporter =
+ let open Fmt in
+ let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%04.02f")) in
+ let pp_header ppf v =
+ let color = color_of_log_level (fst v) in
+ let pp = styled (`Fg color) Logs.pp_header in
+ pf ppf "%a" pp v
+ in
+ let pp_src_name =
+ let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in
+ fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v
+ in
+ let pp_detail = option (styled `Green (fmt " (%s)")) in
+ let report src lvl ~over k msgf =
+ let ppf =
+ match lvl with
+ | Logs.App -> stdout
+ | Error | Warning | Info | Debug -> stderr
+ in
+ let k _ppf = over (); k () in
+ let with_detail h tags k user_fmt =
+ let detail = Option.bind tags (Logs.Tag.find detail_tag) in
+ let timestamp =
+ Ptime.sub_span (Ptime_clock.now ()) time_anchor
+ |> Option.map Ptime.to_float_s
+ |> Option.value ~default:0.
+ in
+ let k ppf = kpf k ppf "%a@." pp_detail detail in
+ let k ppf = kpf k ppf user_fmt in
+ kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h)
+ pp_src_name src
+ in
+ msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
+ in
+ { report }
+
+ (* TODO logs
+ - vif shouldn't use/set the default reporter
+ - Log.err all `Internal_server_error response *)
+ let setup () =
+ let level = Some Logs.Info in
+ Logs.set_level ~all:false level;
+ Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
+ Logs.Src.set_level Logs.default level;
+ Logs_threaded.enable ();
+ Logs.set_reporter reporter;
+ ()
+end
diff --git a/.jjconflict-side-1/test/auditor_public_key b/.jjconflict-side-1/test/auditor_public_key
new file mode 100644
index 00000000..4b97fccf
--- /dev/null
+++ b/.jjconflict-side-1/test/auditor_public_key
@@ -0,0 +1 @@
+A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0
diff --git a/.jjconflict-side-1/test/crypto.ml b/.jjconflict-side-1/test/crypto.ml
new file mode 100644
index 00000000..83650235
--- /dev/null
+++ b/.jjconflict-side-1/test/crypto.ml
@@ -0,0 +1,32 @@
+let round_trip s =
+ let s' = s |> B32.encode |> B32.decode |> Result.get_ok in
+ match s' = s with
+ | false -> Fmt.failwith "b32 round trip failure: @\nin :`%S`@\nout:`%S`" s' s
+ | true -> ()
+
+let () =
+ let s = String.init 0xff Char.chr in
+ round_trip s;
+ let s_l = List.init 0x0f (fun i -> String.init i Char.chr) in
+ List.iter round_trip s_l; ()
+
+(* TODO *)
+(* test vectors from:
+ https://git.gnunet.org/gnunet/gnunet/file/src/cli/util/crypto-test-vectors.json.html *)
+
+let () =
+ let input = "91JPRV3F5GG4EKJNDSJQ8" in
+ let expected =
+ "D0R24RZ1TPASVQ2NY56CT8AJDYZE9ZGDB0GVZ05E9D4YGZQW2RC5YFPQ0Q86EPW836DY7VYQTNFFJT3ZR2K508F4JVS5JNJKYN2MMFR"
+ in
+ let output =
+ input
+ |> B32.decode
+ |> Result.get_ok
+ |> Hash.H64.hash
+ |> Hash.H64.to_octets
+ |> B32.encode
+ in
+ assert (output = expected);
+
+ ()
diff --git a/.jjconflict-side-1/test/dune b/.jjconflict-side-1/test/dune
new file mode 100644
index 00000000..1aa7506a
--- /dev/null
+++ b/.jjconflict-side-1/test/dune
@@ -0,0 +1,16 @@
+(test
+ (name test)
+ (modules test)
+ (libraries mte fmt))
+
+(test
+ (name crypto)
+ (modules crypto)
+ (libraries mte fmt))
+
+; TODO
+; cram test?
+; gcc -o a.out ./test/signatures.c && ./a.out > a.output
+; rm ./a.out
+; dune exec ./test/test.exe > b.output
+; cmp -l a.output b.output
diff --git a/.jjconflict-side-1/test/offline_management.sh b/.jjconflict-side-1/test/offline_management.sh
new file mode 100755
index 00000000..119c46e0
--- /dev/null
+++ b/.jjconflict-side-1/test/offline_management.sh
@@ -0,0 +1,58 @@
+#!/bin/bash
+
+set -e
+
+a="/tmp/a.json"
+b="/tmp/b.json"
+
+url="http://localhost:3434"
+auditor_pub=$(<"./test/auditor_public_key")
+master_key="./default/master_offline_private_key"
+zero_euro="EUR:0.0"
+
+offline_tool() {
+ dune exec offline -- "$@" > /dev/null
+}
+
+offline_tool download --output $a --url $url"/management/keys"
+offline_tool sign \
+--master_key $master_key \
+--input $a \
+--output $b
+offline_tool upload --input $b --url $url"/management/keys"
+echo "[OK] /management/keys"
+
+offline_tool enable-auditor \
+--master_key $master_key \
+--output $b \
+--auditor_url "auditor.example.com" \
+--auditor_name "auditor example" \
+--auditor_pub $auditor_pub \
+--validity_start 0
+offline_tool upload --input $b --url $url"/management/auditors"
+echo "[OK] /management/auditors"
+
+offline_tool wire-fee \
+--master_key $master_key \
+--output $b \
+--wire_method "xxx" \
+--fee_start 0 \
+--fee_end 99999999 \
+--closing_fee $zero_euro \
+--wire_fee $zero_euro
+offline_tool upload --input $b --url $url"/management/wire-fee"
+echo "[OK] /management/wire-fee"
+
+offline_tool global-fees \
+--master_key $master_key \
+--output $b \
+--start_date 0 \
+--end_date 99999999 \
+--history_fee $zero_euro \
+--account_fee $zero_euro \
+--purse_fee $zero_euro \
+--history_expiration 9999999 \
+--purse_account_limit 1 \
+--purse_timeout 9999999
+offline_tool upload --input $b --url $url"/management/global-fees"
+echo "[OK] /management/global-fees"
diff --git a/.jjconflict-side-1/test/signatures.c b/.jjconflict-side-1/test/signatures.c
new file mode 100644
index 00000000..bcebe993
--- /dev/null
+++ b/.jjconflict-side-1/test/signatures.c
@@ -0,0 +1,55 @@
+#include
+#include
+
+struct H64 {
+ uint8_t hash[64];
+};
+struct Hhh {
+ struct H64 hash;
+};
+struct Purpose {
+ uint32_t size;
+ uint32_t purpose;
+};
+
+struct PS {
+ struct Purpose purpose;
+ struct Hhh h;
+ uint32_t noreveal_index;
+};
+
+int main(void) {
+ struct Purpose purpose;
+ struct PS ps;
+
+ purpose.size = 3 * 4 + 64;
+ purpose.purpose = 1050;
+
+ struct Hhh h = {
+ .hash = {
+ .hash = {
+ 1 , 2 , 3 , 4 , 5, 6, 7, 8,
+ 9 , 10, 11, 12, 13, 14, 15, 16,
+ 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, 40,
+ 41, 42, 43, 44, 45, 46, 47, 48,
+ 49, 50, 51, 52, 53, 54, 55, 56,
+ 57, 58, 59, 60, 61, 62, 63, 64
+ }
+ }
+ };
+
+ uint32_t noreveal_index = 0;
+
+ ps.purpose = purpose;
+ ps.h = h;
+ ps.noreveal_index = noreveal_index;
+
+
+ fwrite(&ps, sizeof(ps), 1, stdout);
+
+ // printf("\n");
+
+ return 0;
+}
diff --git a/.jjconflict-side-1/test/test.ml b/.jjconflict-side-1/test/test.ml
new file mode 100644
index 00000000..b1c2810b
--- /dev/null
+++ b/.jjconflict-side-1/test/test.ml
@@ -0,0 +1,115 @@
+let () = Mirage_crypto_rng_unix.use_default ()
+
+let () =
+ let priv = Mirage_crypto_pk.Rsa.generate ~bits:2048 () in
+ let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in
+ let () =
+ let open Crypto.RsaPrivateKey in
+ let priv' = priv |> to_octets |> of_octets |> Result.get_ok in
+ assert (to_octets priv = to_octets priv')
+ in
+ let () =
+ let open Crypto.RsaPublicKey in
+ let pub' = pub |> to_octets |> of_octets |> Result.get_ok in
+ assert (to_octets pub = to_octets pub')
+ in
+ ()
+
+let () =
+ let open Api in
+ let check jsont s =
+ let encode v = encode jsont v |> Result.get_ok in
+ let decode v = decode jsont v |> Result.get_ok in
+ let ts = decode s in
+ let s' = encode ts in
+ let ts' = decode s' in
+ let s'' = encode ts' in
+ assert (String.equal s' s'')
+ in
+ let check_bad jsont s =
+ let decode = decode jsont in
+ assert (Result.is_error (decode s))
+ in
+ check Timestamp.jsont {|{"t_s": 123456780}|};
+ check Timestamp.jsont {|{"t_s": "never"}|};
+ check_bad Timestamp.jsont {|{"t_s": "123456780"}|};
+ check_bad Timestamp.jsont {|{"t_s": "agagou"}|};
+
+ (* CS not implemented *)
+ check_bad DenominationKey.jsont
+ {|{"cipher": "CS", "age_mask": 18, "cs_pub": "ouhagag"}|};
+
+ (* TODO test with a valid rsa_pub value *)
+ (* TODO handle "rsa pub_of_octets failure" correctly *)
+ (* check_bad DenominationKey.jsont
+ {|{"cipher": "RSA", "age_mask": 18, "rsa_pub": "agagouh"}|}; *)
+ ()
+
+let () =
+ let open Amount in
+ let v =
+ make ~sign:(Some Sign_plus) ~currency:"EUR" ~value:(Int64.of_int 25)
+ ~fraction:(Int32.of_int 678)
+ |> Result.get_ok
+ in
+ let s = to_string v in
+ let v' = of_string s |> Result.get_ok in
+ assert (v = v');
+ let r = of_string {|~EUR:4.9|} in
+ assert (Result.is_error r);
+ let r = of_string {|+EUR:4.99999999999999999999999|} in
+ assert (Result.is_error r);
+ ()
+
+let () =
+ let open Headers_lib.If_none_match in
+ let ok_l =
+ [
+ "*";
+ "\"foo\"";
+ "W/\"foo\"";
+ "\"foo\", \"bar\"";
+ " , W/\"x\" , W/\"y\" , \"z\"";
+ ", \"one\" , \"two\" , \"three\"";
+ "W/\"a\" , ";
+ "W/\"a\" , \"b\"";
+ ]
+ in
+ let bad_l =
+ [
+ "";
+ "foo";
+ "W/foo";
+ "W/\"unterminated";
+ "\"foo\", W/";
+ "* , \"bar\"";
+ "\"a\" \"b\"";
+ "W/\"a\" W/\"b\"";
+ "\"fo\x7Fo\"";
+ " W/\"a\"";
+ "W/\"a\" ";
+ ]
+ in
+ let check_ok input = assert (Result.is_ok (parse input)) in
+ let check_bad input = assert (Result.is_error (parse input)) in
+ List.iter check_ok ok_l;
+ List.iter check_bad bad_l;
+
+ ()
+
+(*
+
+let () =
+ let 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-1/tools/dbinit.sh b/.jjconflict-side-1/tools/dbinit.sh
new file mode 100755
index 00000000..4d74bc9a
--- /dev/null
+++ b/.jjconflict-side-1/tools/dbinit.sh
@@ -0,0 +1,100 @@
+#!/bin/bash
+
+# TODO
+# use specific commit
+
+# usage:
+# `create_database`
+# create a `taler-exchange` database
+# `fetch`
+# fetch all *.sql and *.sql.in files from GNU Taler exchange repository (latest commit)
+# `init`
+# initialize taler-exchange database (create tables, ...)
+# `taler-exchange` database must already be created
+#
+
+
+set -e
+
+taler_repo_url="https://git-www.taler.net/exchange.git/"
+
+tmp_dir="/tmp/taler_exchange"
+out_dir="./_taler_exchange_sql"
+init_sql="${out_dir}/init.sql"
+drop_sql="${out_dir}/drop.sql"
+
+# psql parameter
+host="localhost"
+port=5432
+username="mte"
+dbname="taler-exchange"
+
+fetch() {
+ git clone --depth 1 $taler_repo_url $tmp_dir
+}
+
+process() {
+ source_dir="${tmp_dir}/src/exchangedb"
+ sql_in_files=(
+ "procedures.sql"
+ "exchange-0002.sql"
+ "exchange-0003.sql"
+ "exchange-0004.sql"
+ )
+ for file in "${sql_in_files[@]}"; do
+ file_in="${source_dir}/${file}.in"
+ file_out="${source_dir}/${file}"
+ gcc -E -P -undef -I "$source_dir" - < "$file_in" \
+ 2>/dev/null \
+ > "$file_out"
+ done
+ # order is important
+ files=(
+ "versioning.sql"
+ "exchange-0001.sql"
+ "exchange-0002.sql"
+ "exchange-0003.sql"
+ "exchange-0004.sql"
+ "exchange-0005.sql"
+ "procedures.sql"
+ )
+ mkdir -p "$out_dir"
+ cat "${source_dir}/drop.sql" > "$drop_sql"
+ echo "" > "$init_sql"
+ for file in "${files[@]}"; do
+ cat "${source_dir}/${file}" >> "$init_sql"
+ done
+}
+
+# ? "NOTICE: function xxx() does not exist, skipping"
+init() {
+ psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$init_sql
+}
+
+drop_schema() {
+ psql --host=$host --port=$port --username=$username --password --dbname=$dbname --file=$drop_sql
+}
+
+create_database() {
+ createdb --host=$host --port=$port --username=$username --password $dbname
+}
+
+drop_database() {
+ dropdb --host=$host --port=$port --username=$username --password $dbname
+}
+
+if [[ $# -eq 0 ]]; then
+ echo "no argument" >&2
+ exit 1
+fi
+
+cmd=$1
+case "$cmd" in
+ fetch) fetch "$@"; exit 0;;
+ process) process "$@"; exit 0;;
+ init) init "$@"; exit 0;;
+ drop_schema) drop_schema "$@"; exit 0;;
+ create_database) create_database "$@"; exit 0;;
+ drop_database) drop_database "$@"; exit 0;;
+ *) echo "Unknown command: $cmd" >&2; exit 1;;
+esac
diff --git a/.jjconflict-side-1/tools/dune b/.jjconflict-side-1/tools/dune
new file mode 100644
index 00000000..4f5057ca
--- /dev/null
+++ b/.jjconflict-side-1/tools/dune
@@ -0,0 +1,11 @@
+(executable
+ (public_name offline)
+ (name offline)
+ (modules offline offline_impl)
+ (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
+
+(executable
+ (public_name gen_signatures_registry)
+ (name gen_signatures_registry)
+ (modules gen_signatures_registry)
+ (libraries angstrom bos fmt))
diff --git a/.jjconflict-side-1/tools/gen_signatures_registry.ml b/.jjconflict-side-1/tools/gen_signatures_registry.ml
new file mode 100644
index 00000000..3d3a4191
--- /dev/null
+++ b/.jjconflict-side-1/tools/gen_signatures_registry.ml
@@ -0,0 +1,109 @@
+module Recfile = struct
+ (* rudimentary recfile parser
+ https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
+ open Angstrom
+
+ type field = {
+ k: string;
+ v: string;
+ }
+
+ type record = field list
+
+ let newline = char '\n'
+ let is_newline = function '\n' -> true | _ -> false
+
+ let field_name =
+ let first_char =
+ satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
+ in
+ let subsequent_char =
+ satisfy (function
+ | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
+ | _ -> false)
+ in
+ lift2
+ (fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
+ first_char (many subsequent_char)
+
+ (* todo handle '\' escape and '+' on next line *)
+ let field_value = take_till is_newline <* newline
+
+ let field =
+ let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
+ let blanks = skip_many1 blank in
+ lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
+
+ let blank = newline *> return ()
+ let comment = (char '#' *> take_till is_newline <* newline) *> return ()
+ let record = many1 field
+
+ let records =
+ let sep =
+ (* at least one blank line *)
+ skip_many comment *> blank *> skip_many (comment <|> blank)
+ in
+ sep_by1 sep record
+
+ let recfile : record list t =
+ skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
+
+ let parse s = parse_string ~consume:All recfile s
+end
+
+let url =
+ "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
+
+let registry_file = "registry.rec"
+
+let download () =
+ let open Bos in
+ let res =
+ OS.Cmd.run Cmd.(v "curl" % "-s" % "-o" % registry_file % "-X" % "GET" % url)
+ in
+ match res with
+ | Error (`Msg s) -> Fmt.failwith "download failure: %s" s
+ | Ok () -> ()
+
+let read_file file = In_channel.with_open_bin file In_channel.input_all
+
+type purpose = {
+ number: int32;
+ name: string;
+ comment: string;
+}
+
+let parse_purposes records =
+ records
+ |> List.filter_map (fun l ->
+ match l with
+ | a :: b :: c :: _ -> (
+ let open Recfile in
+ match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
+ | false -> None
+ | true ->
+ Some
+ {
+ number= Int32.of_int (int_of_string a.v);
+ name= String.lowercase_ascii b.v;
+ comment= c.v;
+ })
+ | _ -> None)
+ |> List.filter (fun v -> v.number >= 1000_l)
+
+let () =
+ download ();
+ let content = read_file registry_file in
+ match Recfile.parse content with
+ | Error msg -> Fmt.failwith "Recfile parse error: %s" msg
+ | Ok records ->
+ let purposes = parse_purposes records in
+ let header =
+ {|(* This file was generated from the GANA database:
+ https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|}
+ in
+ let pp ppf { number; name; comment } =
+ Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
+ in
+ Fmt.pr "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
+ ()
diff --git a/.jjconflict-side-1/tools/offline.ml b/.jjconflict-side-1/tools/offline.ml
new file mode 100644
index 00000000..5864bd0c
--- /dev/null
+++ b/.jjconflict-side-1/tools/offline.ml
@@ -0,0 +1,301 @@
+(* TODO
+ better cmd doc
+ change arguments: '_' -> '-'
+
+ 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 master_key =
+ let doc = "Master offline Eddsa private key file." in
+ Arg.(required & opt (some file) None & info [ "master_key" ] ~doc)
+
+let input =
+ let doc = "input file" in
+ Arg.(required & opt (some file) None & info [ "i"; "input" ] ~doc)
+
+let output =
+ let doc = "output file" in
+ Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
+
+let url =
+ let doc = "url" in
+ Arg.(required & opt (some string) None & info [ "url" ] ~doc)
+
+let setup_cmd =
+ let doc = "Generate offline master keys" in
+ let output =
+ let doc = "output file" in
+ Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
+ in
+ Cmd.make (Cmd.info "setup" ~doc)
+ @@
+ let+ output = output in
+ setup ~output
+
+let download_cmd =
+ let doc = "GET" in
+ Cmd.make (Cmd.info "download" ~doc)
+ @@
+ let+ output = output and+ url = url in
+ download ~output ~url
+
+let upload_cmd =
+ let doc = "POST" in
+ Cmd.make (Cmd.info "upload" ~doc)
+ @@
+ let+ input = input and+ url = url in
+ upload ~input ~url
+
+let sign_cmd =
+ let doc = "Sign FutureKeysResponse." in
+ Cmd.make (Cmd.info "sign" ~doc)
+ @@
+ let+ input = input and+ output = output and+ master_key = master_key in
+ sign ~input ~output ~master_key
+
+let revoke_denom_cmd =
+ let doc = "Revoke denomination." in
+ let h_denom =
+ let doc = "hash of denomination public key" in
+ Arg.(required & pos 0 (some string) None & info [] ~doc)
+ in
+ Cmd.make (Cmd.info "revoke-denom" ~doc)
+ @@
+ let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
+ revoke_denom ~output ~master_key ~h_denom
+
+let revoke_signkey_cmd =
+ let doc = "Revoke signkey." in
+ let signkey =
+ let doc = "public signing key" in
+ Arg.(required & pos 0 (some eddsa_pub) None & info [] ~doc)
+ in
+ Cmd.make (Cmd.info "revoke-signkey" ~doc)
+ @@
+ let+ output = output and+ master_key = master_key and+ signkey = signkey in
+ revoke_signkey ~output ~master_key ~signkey
+
+let enable_auditor_cmd =
+ let doc = "Enable auditor." in
+ let auditor_url =
+ Arg.(required & opt (some string) None & info [ "auditor_url" ])
+ in
+ let auditor_name =
+ Arg.(required & opt (some string) None & info [ "auditor_name" ])
+ in
+ let auditor_pub =
+ Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
+ in
+ let validity_start =
+ Arg.(required & opt (some timestamp) None & info [ "validity_start" ])
+ in
+ Cmd.make (Cmd.info "enable-auditor" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ auditor_url = auditor_url
+ and+ auditor_name = auditor_name
+ and+ auditor_pub = auditor_pub
+ and+ validity_start = validity_start in
+ enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
+ ~validity_start
+
+let disable_auditor_cmd =
+ let doc = "Disable auditor." in
+ let auditor_pub =
+ Arg.(required & opt (some eddsa_pub) None & info [ "auditor_pub" ])
+ in
+ let validity_end =
+ Arg.(required & opt (some timestamp) None & info [ "validity_end" ])
+ in
+ Cmd.make (Cmd.info "disable-auditor" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ auditor_pub = auditor_pub
+ and+ validity_end = validity_end in
+ disable_auditor ~output ~master_key ~auditor_pub ~validity_end
+
+let wire_fee_cmd =
+ let doc = "Provides wire fee configuration." in
+ let wire_method =
+ Arg.(required & opt (some string) None & info [ "wire_method" ])
+ in
+ let fee_start =
+ Arg.(required & opt (some timestamp) None & info [ "fee_start" ])
+ in
+ let fee_end =
+ Arg.(required & opt (some timestamp) None & info [ "fee_end" ])
+ in
+ let closing_fee =
+ Arg.(required & opt (some amount) None & info [ "closing_fee" ])
+ in
+ let wire_fee =
+ Arg.(required & opt (some amount) None & info [ "wire_fee" ])
+ in
+ Cmd.make (Cmd.info "wire-fee" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ wire_method = wire_method
+ and+ fee_start = fee_start
+ and+ fee_end = fee_end
+ and+ closing_fee = closing_fee
+ and+ wire_fee = wire_fee in
+ Offline_impl.wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end
+ ~closing_fee ~wire_fee
+
+let global_fees_cmd =
+ let doc = "Provides global fee configuration." in
+ let start_date =
+ Arg.(required & opt (some timestamp) None & info [ "start_date" ])
+ in
+ let end_date =
+ Arg.(required & opt (some timestamp) None & info [ "end_date" ])
+ in
+ let history_fee =
+ Arg.(required & opt (some amount) None & info [ "history_fee" ])
+ in
+ let account_fee =
+ Arg.(required & opt (some amount) None & info [ "account_fee" ])
+ in
+ let purse_fee =
+ Arg.(required & opt (some amount) None & info [ "purse_fee" ])
+ in
+ let history_expiration =
+ Arg.(
+ required & opt (some relative_time) None & info [ "history_expiration" ])
+ in
+ let purse_account_limit =
+ Arg.(required & opt (some int) None & info [ "purse_account_limit" ])
+ in
+ let purse_timeout =
+ Arg.(required & opt (some relative_time) None & info [ "purse_timeout" ])
+ in
+ Cmd.make (Cmd.info "global-fees" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ start_date = start_date
+ and+ end_date = end_date
+ and+ history_fee = history_fee
+ and+ account_fee = account_fee
+ and+ purse_fee = purse_fee
+ and+ history_expiration = history_expiration
+ and+ purse_account_limit = purse_account_limit
+ and+ purse_timeout = purse_timeout in
+ global_fees ~output ~master_key ~start_date ~end_date ~history_fee
+ ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
+ ~purse_timeout
+
+let drain_cmd =
+ let doc =
+ "Drain profits from the exchange. The actual drain requires running the \
+ `taler-exchange-drain` tool."
+ in
+ let debit_account_section =
+ Arg.(required & opt (some string) None & info [ "debit_account_section" ])
+ in
+ let credit_payto_uri =
+ Arg.(required & opt (some string) None & info [ "credit_payto_uri" ])
+ in
+ let wtid = Arg.(required & opt (some b32) None & info [ "wtid" ]) in
+ let date = Arg.(required & opt (some timestamp) None & info [ "date" ]) in
+ let amount = Arg.(required & opt (some amount) None & info [ "amount" ]) in
+ Cmd.make (Cmd.info "drain" ~doc)
+ @@
+ let+ output = output
+ and+ master_key = master_key
+ and+ debit_account_section = debit_account_section
+ and+ credit_payto_uri = credit_payto_uri
+ and+ wtid = wtid
+ and+ date = date
+ and+ amount = amount in
+ drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid ~date
+ ~amount
+
+let cli =
+ let info =
+ let doc = "MTE Offline CLI tool" in
+ Cmd.info "mte-offline" ~doc
+ in
+ Cmd.group info
+ [
+ setup_cmd;
+ download_cmd;
+ sign_cmd;
+ upload_cmd;
+ revoke_denom_cmd;
+ revoke_signkey_cmd;
+ enable_auditor_cmd;
+ disable_auditor_cmd;
+ wire_fee_cmd;
+ global_fees_cmd;
+ drain_cmd;
+ ]
+
+let main () = Cmd.eval_result cli
+let () = if !Sys.interactive then () else exit (main ())
diff --git a/.jjconflict-side-1/tools/offline_impl.ml b/.jjconflict-side-1/tools/offline_impl.ml
new file mode 100644
index 00000000..d8a1fa18
--- /dev/null
+++ b/.jjconflict-side-1/tools/offline_impl.ml
@@ -0,0 +1,368 @@
+open Syntax
+open Hash
+
+module Future_keys = struct
+ open Crypto
+ open Api
+
+ let verify =
+ let verify_future_denom ~sm_denom_pub
+ FutureDenom.
+ {
+ section_name;
+ value= _;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit= _;
+ stamp_expire_legal= _;
+ denom_pub;
+ fee_withdraw= _;
+ fee_deposit= _;
+ fee_refresh= _;
+ fee_refund= _;
+ denom_secmod_sig;
+ } =
+ let h_denom_pub =
+ DenominationHash.hash (DenominationKey.to_octets denom_pub)
+ in
+ let h_section_name = Hash.Cstring.H64.hash section_name in
+ let anchor_time = stamp_start in
+ let duration_withdraw =
+ Timestamp.diff stamp_start stamp_expire_withdraw
+ in
+ let open Signatures.DenominationKeyAnnouncement in
+ verify_f
+ ~f:(EddsaSignature.verify ~key:sm_denom_pub)
+ denom_secmod_sig
+ { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
+ in
+ let verify_future_signkey ~sm_signkey_pub
+ FutureSignKey.
+ { key; stamp_start; stamp_expire; stamp_end= _; signkey_secmod_sig } =
+ let exchange_pub = key in
+ let anchor_time = stamp_start in
+ let duration = Timestamp.diff stamp_start stamp_expire in
+ let open Signatures.SigningKeyAnnouncement in
+ verify_f
+ ~f:(EddsaSignature.verify ~key:sm_signkey_pub)
+ signkey_secmod_sig
+ { exchange_pub; anchor_time; duration }
+ in
+ fun our_master_public_key
+ FutureKeysResponse.
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub;
+ denom_secmod_public_key;
+ signkey_secmod_public_key;
+ }
+ ->
+ let* () =
+ match master_pub = our_master_public_key with
+ | false ->
+ Fmt.error
+ "master public key of the future key response does not match ours"
+ | true -> Ok ()
+ in
+ let* () =
+ list_iter
+ (verify_future_denom ~sm_denom_pub:denom_secmod_public_key)
+ future_denoms
+ in
+ let* () =
+ list_iter
+ (verify_future_signkey ~sm_signkey_pub:signkey_secmod_public_key)
+ future_signkeys
+ in
+ Ok ()
+
+ let make =
+ let denom_signature ~master_key
+ FutureDenom.
+ {
+ section_name= _;
+ value;
+ stamp_start;
+ stamp_expire_withdraw;
+ stamp_expire_deposit;
+ stamp_expire_legal;
+ denom_pub;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_secmod_sig= _;
+ } =
+ let octets = DenominationKey.to_octets denom_pub in
+ let h_denom_pub = DenominationHash.hash octets in
+ let master_sig =
+ let open Signatures.DenominationKeyValidity in
+ let master = EddsaPrivateKey.(pub_of_priv master_key) in
+ sign_f
+ ~f:(EddsaSignature.sign ~key:master_key)
+ {
+ master;
+ start= stamp_start;
+ expire_withdraw= stamp_expire_withdraw;
+ expire_spend= stamp_expire_deposit;
+ expire_legal= stamp_expire_legal;
+ value;
+ fee_withdraw;
+ fee_deposit;
+ fee_refresh;
+ fee_refund;
+ denom_hash= h_denom_pub;
+ }
+ in
+ DenomSignature.{ h_denom_pub; master_sig }
+ in
+ let signkey_signature ~master_key
+ FutureSignKey.
+ { key; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig= _ } =
+ let master_sig =
+ let open Signatures.ExchangeSigningKeyValidity in
+ sign_f
+ ~f:(EddsaSignature.sign ~key:master_key)
+ {
+ start= stamp_start;
+ expire= stamp_expire;
+ end_= stamp_end;
+ signkey_pub= key;
+ }
+ in
+ SignKeySignature.{ key; master_sig }
+ in
+ fun ~master_key
+ FutureKeysResponse.
+ {
+ future_denoms;
+ future_signkeys;
+ master_pub= _;
+ denom_secmod_public_key= _;
+ signkey_secmod_public_key= _;
+ }
+ ->
+ let denom_sigs = List.map (denom_signature ~master_key) future_denoms in
+ let signkey_sigs =
+ List.map (signkey_signature ~master_key) future_signkeys
+ in
+ MasterSignatures.{ denom_sigs; signkey_sigs }
+end
+
+(* -- *)
+
+let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_err_msg
+
+let write_file fname content =
+ Bos.OS.File.write (Fpath.v fname) content |> unwrap_err_msg
+
+let read_master_key_file filename =
+ let* master_key = read_file filename in
+ Crypto.EddsaPrivateKey.of_octets master_key
+
+let download ~output ~url =
+ let open Bos in
+ OS.Cmd.run Cmd.(v "curl" % "--silent" % "-o" % output % "-X" % "GET" % url)
+ |> unwrap_err_msg
+
+let upload ~input ~url =
+ let open Bos in
+ OS.Cmd.run
+ Cmd.(
+ v "curl"
+ % "--silent"
+ % "-i"
+ % "-X"
+ % "POST"
+ % "-H"
+ % "Content-Type: application/json"
+ % "--data"
+ % ("@" ^ input)
+ % url)
+ |> unwrap_err_msg
+
+let setup ~output =
+ 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* () = Future_keys.verify master_pub future_keys_response in
+ let master_signatures = Future_keys.make ~master_key future_keys_response in
+ let* s = Api.encode Api.MasterSignatures.jsont master_signatures in
+ let* () = write_file output s in
+ Ok ()
+
+let revoke_denom ~output ~master_key ~h_denom =
+ let* key = read_master_key_file master_key in
+ let* h_denom_pub = DenominationHash.of_b32 h_denom in
+ let denom_revoke =
+ let master_sig =
+ let open Signatures.MasterDenominationKeyRevocation in
+ sign_f ~f:(Crypto.EddsaSignature.sign ~key) { h_denom_pub }
+ in
+ Api.DenomRevocationSignature.{ master_sig }
+ in
+ let* s = Api.encode Api.DenomRevocationSignature.jsont denom_revoke in
+ let* () = write_file output s in
+ Ok ()
+
+let revoke_signkey ~output ~master_key ~signkey =
+ let* key = read_master_key_file master_key in
+ let signkey_revoke =
+ let master_sig =
+ let open Signatures.MasterSigningKeyRevocation in
+ sign_f ~f:(Crypto.EddsaSignature.sign ~key) { exchange_pub= signkey }
+ in
+ Api.SignkeyRevocationSignature.{ master_sig }
+ in
+ let* s = Api.encode Api.SignkeyRevocationSignature.jsont signkey_revoke in
+ let* () = write_file output s in
+ Ok ()
+
+let global_fees ~output ~master_key ~start_date ~end_date ~history_fee
+ ~account_fee ~purse_fee ~history_expiration ~purse_account_limit
+ ~purse_timeout =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let* purse_account_limit =
+ match
+ purse_account_limit >= 0
+ && purse_account_limit <= Int32.to_int Int32.max_int
+ with
+ | false -> Error "invalid purse_account_limit value"
+ | true -> Ok (Int32.of_int purse_account_limit)
+ in
+ let master_sig =
+ let open Signatures.GlobalFees in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ }
+ in
+ let global_fees =
+ Api.GlobalFees.
+ {
+ start_date;
+ end_date;
+ purse_timeout;
+ history_expiration;
+ history_fee;
+ account_fee;
+ purse_fee;
+ purse_account_limit;
+ master_sig;
+ }
+ in
+ let* s = Api.encode Api.GlobalFees.jsont global_fees in
+ let* () = write_file output s in
+ Ok ()
+
+let enable_auditor ~output ~master_key ~auditor_url ~auditor_name ~auditor_pub
+ ~validity_start =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig =
+ let open Signatures.MasterAddAuditor in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ start_date= validity_start;
+ auditor_pub;
+ h_auditor_url= Hash.Cstring.H64.hash auditor_url;
+ }
+ in
+ let v =
+ Api.AuditorSetupMessage.
+ { auditor_url; auditor_name; auditor_pub; master_sig; validity_start }
+ in
+ let* s = Api.encode Api.AuditorSetupMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
+
+let disable_auditor ~output ~master_key ~auditor_pub ~validity_end =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig =
+ let open Signatures.MasterDelAuditor in
+ sign_f ~f:(EddsaSignature.sign ~key) { end_date= validity_end; auditor_pub }
+ in
+ let v = Api.AuditorTeardownMessage.{ master_sig; validity_end } in
+ let* s = Api.encode Api.AuditorTeardownMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
+
+let wire_fee ~output ~master_key ~wire_method ~fee_start ~fee_end ~closing_fee
+ ~wire_fee =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig_wire =
+ let open Signatures.MasterWireFee in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ h_wire_method= Hash.Cstring.H64.hash wire_method;
+ start_date= fee_start;
+ end_date= fee_end;
+ closing_fee;
+ wire_fee;
+ }
+ in
+ let v =
+ Api.WireFeeSetupMessage.
+ {
+ wire_method;
+ fee_start;
+ fee_end;
+ closing_fee;
+ wire_fee;
+ master_sig_wire;
+ }
+ in
+ let* s = Api.encode Api.WireFeeSetupMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
+
+let drain ~output ~master_key ~debit_account_section ~credit_payto_uri ~wtid
+ ~date ~amount =
+ let open Crypto in
+ let* key = read_master_key_file master_key in
+ let master_sig =
+ let open Signatures.MasterDrainProfit in
+ sign_f ~f:(EddsaSignature.sign ~key)
+ {
+ wtid;
+ date;
+ amount;
+ h_section= Hash.Cstring.H64.hash debit_account_section;
+ h_payto= FullPaytoHash.hash credit_payto_uri;
+ }
+ in
+ let v =
+ Api.DrainProfitsMessage.
+ {
+ debit_account_section;
+ credit_payto_uri;
+ wtid;
+ master_sig;
+ date;
+ amount;
+ }
+ in
+ let* s = Api.encode Api.DrainProfitsMessage.jsont v in
+ let* () = write_file output s in
+ Ok ()
diff --git a/README b/README
new file mode 100644
index 00000000..5be01972
--- /dev/null
+++ b/README
@@ -0,0 +1,11 @@
+This commit was made by jj, https://jj-vcs.dev/.
+The commit contains file conflicts, and therefore looks wrong when used with plain
+Git or other tools that are unfamiliar with jj.
+
+The .jjconflict-* directories represent the different inputs to the conflict.
+For details, see
+https://docs.jj-vcs.dev/prerelease/git-compatibility/#format-mapping-details
+
+If you see this file in your working copy, it probably means that you used a
+regular `git` command to check out a conflicted commit. Use `jj abandon` to
+recover.
diff --git a/src/headers_lib.ml b/src/headers_lib.ml
deleted file mode 100644
index ce9c7257..00000000
--- a/src/headers_lib.ml
+++ /dev/null
@@ -1,83 +0,0 @@
-(* library for headers fields value *)
-
-(* TODO clean up *)
-module Etag : sig
- (* 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