better if-not-match

.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

.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 terms_etag = get "terms_etag" |> etag
-  let privacy_etag = get "privacy_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"

.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

.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

.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? *)

.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

.jjconflict-base-0/test/test.ml

@@ -62,32 +62,39 @@ let () =
   ()
 
 let () =
-  let open Headers_lib.Etag in
+  let open Headers_lib.If_none_match in
-  let check input = assert (Result.is_ok (parse input)) 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\"";
   ()
 
 (*

.jjconflict-side-0/.gitignore

@@ -0,0 +1,5 @@
+_build
+_taler_exchange_sql
+assets
+secrets
+!secrets/.keep

.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

.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. <https://fsf.org/>
+ 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.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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 <https://www.gnu.org/licenses/>.
+
+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
+<https://www.gnu.org/licenses/>.

.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

.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

.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

.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

.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

.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 <swrup@protonmail.com>")
+
+(maintainers "Olivier Pierre <swrup@protonmail.com>")
+
+(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)
+   ))

.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 <swrup@protonmail.com>"]
+authors: ["Olivier Pierre <swrup@protonmail.com>"]
+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)"]

.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

.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 *)

.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

.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

.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

.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))

.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;
+}

.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

.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}))))

.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

.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

.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

.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

.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

.jjconflict-side-0/src/mte.ml

@@ -0,0 +1,83 @@
+(*  MTE - the MirageOS Taler Exchange
+    Copyright (C) 2025 Olivier Pierre <swrup@protonmail.com>
+
+    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 <https://www.gnu.org/licenses/>. *)
+
+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

.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

.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

.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)

.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

.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

.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

.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;
+}

.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 ()

.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

.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

.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

.jjconflict-side-0/src/timestamp.ml

@@ -0,0 +1 @@
+include Time.Timestamp

.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

.jjconflict-side-0/test/auditor_public_key

@@ -0,0 +1 @@
+A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0