From 9cfdd009223a28e71f69322b485960110d9c7f80 Mon Sep 17 00:00:00 2001
From: swrup <swrup@protonmail.com>
Date: Sun, 30 Nov 2025 11:33:51 +0100
Subject: [PATCH] ~

---
 .ocamlformat    |  2 +-
 src/amount.ml   |  3 ++-
 src/assets.ml   | 12 ++++++++----
 src/database.ml | 44 ++++++++++++++++++++++++++------------------
 src/mte.ml      | 13 +++++++++----
 src/pg.ml       |  7 +++++--
 6 files changed, 51 insertions(+), 30 deletions(-)

diff --git a/.ocamlformat b/.ocamlformat
index 4d907d30..43b12fc0 100644
--- a/.ocamlformat
+++ b/.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
diff --git a/src/amount.ml b/src/amount.ml
index 2b65bd2e..2a49a548 100644
--- a/src/amount.ml
+++ b/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 =
diff --git a/src/assets.ml b/src/assets.ml
index 261442e7..9d6c8088 100644
--- a/src/assets.ml
+++ b/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", "html"), ".html"); (("text", "html"), ".htm");
-      (("application", "pdf"), ".pdf"); (("image", "jpeg"), ".jpg");
-      (("image", "jpeg"), ".jpeg"); (("image", "png"), ".png");
+      (("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");
     ]
 
diff --git a/src/database.ml b/src/database.ml
index 096d0066..07f5661e 100644
--- a/src/database.ml
+++ b/src/database.ml
@@ -2,24 +2,32 @@
    - GNU Taler db-events?
      it seems caqti/pgx does not support it *)
 
+let on_ok req () =
+  let open Vif.Response.Syntax in
+  let* () =
+    Vif.Response.add ~field:"content-type" "text/plain; charset= utf-8"
+  in
+  let* () =
+    Vif.Response.with_string req (Fmt.str "activate_signing_key done~~@.")
+  in
+  Vif.Response.respond `OK
+
+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 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"
-      in
-      let* () =
-        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 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
+  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
diff --git a/src/mte.ml b/src/mte.ml
index 6dcc275d..8439cdb0 100644
--- a/src/mte.ml
+++ b/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 / "privacy" /?? nil) --> Static.privacy;
-    get (rel / "management" / "keys" /?? nil) --> Management.keys_get;
-    post any (rel / "management" / "keys" /?? nil) --> Management.keys_post;
+    get_ (rel /?? nil) --> hello;
+    get_ (rel / "terms" /?? nil) --> Static.terms;
+    get_ (rel / "privacy" /?? nil) --> Static.privacy;
+    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 () =
diff --git a/src/pg.ml b/src/pg.ml
index 4c97f8a4..b6f6264e 100644
--- a/src/pg.ml
+++ b/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;";
-        "SET enable_mergejoin=OFF;"; "SET search_path TO exchange;";
+         SERIALIZABLE;";
+        "SET enable_sort=OFF;";
+        "SET enable_seqscan=OFF;";
+        "SET enable_mergejoin=OFF;";
+        "SET search_path TO exchange;";
       ]
   in
   fun (module Conn : Caqti_miou.CONNECTION) ->