~

.ocamlformat

@@ -2,7 +2,7 @@ version=0.28.1
 exp-grouping=preserve
 type-decl=sparse
 break-infix=fit-or-vertical
-break-collection-expressions=wrap
+break-collection-expressions=fit-or-vertical
 break-sequences=false
 break-infix-before-func=false
 dock-collection-brackets=true

src/amount.ml

@@ -56,7 +56,8 @@ let of_string =
     choice
       [
         char '+' *> return (Some Sign_plus);
-        char '-' *> return (Some Sign_minus); return None;
+        char '-' *> return (Some Sign_minus);
+        return None;
       ]
   in
   let parse_currency =

src/assets.ml

@@ -17,10 +17,14 @@ let privacy_legal_version = "1"
 module Mimetype = struct
   let mimetype_extension_assoc =
     [
-      (("text", "plain"), ".txt"); (("text", "markdown"), ".md");
+      (("text", "plain"), ".txt");
-      (("text", "html"), ".html"); (("text", "html"), ".htm");
+      (("text", "markdown"), ".md");
-      (("application", "pdf"), ".pdf"); (("image", "jpeg"), ".jpg");
+      (("text", "html"), ".html");
-      (("image", "jpeg"), ".jpeg"); (("image", "png"), ".png");
+      (("text", "html"), ".htm");
+      (("application", "pdf"), ".pdf");
+      (("image", "jpeg"), ".jpg");
+      (("image", "jpeg"), ".jpeg");
+      (("image", "png"), ".png");
       (("image", "gif"), ".gif");
     ]
 

src/database.ml

@@ -2,12 +2,7 @@
    - GNU Taler db-events?
      it seems caqti/pgx does not support it *)
 
-let test_activate req server _ =
+let on_ok req () =
-  let db_conn = Vif.Server.device Devices.db_connection server in
-  let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in
-  let exchange_public_key = secmod_signkey.sm_key in
-  match Pg.activate_signing_key db_conn exchange_public_key with
-  | Ok () ->
   let open Vif.Response.Syntax in
   let* () =
     Vif.Response.add ~field:"content-type" "text/plain; charset= utf-8"
@@ -16,10 +11,23 @@ let test_activate req server _ =
     Vif.Response.with_string req (Fmt.str "activate_signing_key done~~@.")
   in
   Vif.Response.respond `OK
-  | Error err ->
+
-      (* TODO don't leak private data in error messages *)
+let on_error req err =
+  (* TODO be sure to not leak private data in error messages *)
   let open Vif.Response.Syntax in
   let str = Fmt.str "Database error: %a." Caqti_error.pp err in
   Logs.err (fun m -> m "%s" str);
   let* () = Vif.Response.with_string req str in
   Vif.Response.respond `Internal_server_error
+
+(* TODO master_sig *)
+let dummy_master_sig =
+  Option.some @@ Crypto.EddsaSignature.of_octets (String.make 64 '\x00')
+
+let test_activate req server _ =
+  let db_conn = Vif.Server.device Devices.db_connection server in
+  let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in
+  let sm_key = secmod_signkey.sm_key in
+  let sm_key = { sm_key with master_sig= dummy_master_sig } in
+  let res = Pg.activate_signing_key db_conn sm_key in
+  Result.fold ~ok:(on_ok req) ~error:(on_error req) res

src/mte.ml

@@ -24,11 +24,16 @@ let routes =
   let open Vif.Uri in
   let open Vif.Route in
   let open Vif.Type in
+  (* just for alignement *)
+  let get_ = get in
+  let post = Fun.flip post in
   [
-    get (rel /?? nil) --> hello; get (rel / "terms" /?? nil) --> Static.terms;
+    get_ (rel /?? nil) --> hello;
-    get (rel / "privacy" /?? nil) --> Static.privacy;
+    get_ (rel / "terms" /?? nil) --> Static.terms;
-    get (rel / "management" / "keys" /?? nil) --> Management.keys_get;
+    get_ (rel / "privacy" /?? nil) --> Static.privacy;
-    post any (rel / "management" / "keys" /?? nil) --> Management.keys_post;
+    get_ (rel / "test" /?? nil) --> Database.test_activate;
+    get_ (rel / "management" / "keys" /?? nil) --> Management.keys_get;
+    post (rel / "management" / "keys" /?? nil) any --> Management.keys_post;
   ]
 
 let () =

src/pg.ml

@@ -71,8 +71,11 @@ let preflight =
       Caqti_type.(unit ->. unit)
       [
         "SET SESSION CHARACTERISTICS AS TRANSACTION ISOLATION LEVEL \
-         SERIALIZABLE;"; "SET enable_sort=OFF;"; "SET enable_seqscan=OFF;";
+         SERIALIZABLE;";
-        "SET enable_mergejoin=OFF;"; "SET search_path TO exchange;";
+        "SET enable_sort=OFF;";
+        "SET enable_seqscan=OFF;";
+        "SET enable_mergejoin=OFF;";
+        "SET search_path TO exchange;";
       ]
   in
   fun (module Conn : Caqti_miou.CONNECTION) ->