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
+  let sm_key = secmod_signkey.sm_key in
-  match Pg.activate_signing_key db_conn exchange_public_key with
+  let sm_key = { sm_key with master_sig= dummy_master_sig } in
-  | Ok () ->
+  let res = Pg.activate_signing_key db_conn sm_key in
-      let open Vif.Response.Syntax in
+  Result.fold ~ok:(on_ok req) ~error:(on_error req) res
-      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

src/mte.ml

@@ -31,6 +31,7 @@ let routes =
     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;
   ]