src/handler.ml

@@ -0,0 +1,57 @@
+module Respond_util = struct
+  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
+end
+
+include Respond_util
+open Api
+
+let keys_get req server _env =
+  let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
+  let sm_denom = Vif.Server.device Devices.secmod_denom server in
+  let res =
+    let v = Management.mk_future_keys_response ~sm_signkey ~sm_denom in
+    let s = Api.encode_exn Api.FutureKeysResponse.jsont v in
+    Ok s
+  in
+  respond_with_res res req
+
+let keys_post_jsont = MasterSignatures.jsont
+
+let keys_post req server _env =
+  let open Syntax in
+  let open Management in
+  let db_conn = Vif.Server.device Devices.db_connection server in
+  let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
+  let sm_denom = Vif.Server.device Devices.secmod_denom server in
+  let res =
+    let* master_signatures = Vif.Request.of_json req |> unwrap_err_msg in
+    let* () =
+      verify_master_signatures ~sm_signkey ~sm_denom master_signatures
+    in
+    let* () =
+      update_master_signatures ~db_conn ~sm_signkey ~sm_denom master_signatures
+    in
+    Ok ""
+  in
+  respond_with_res res req

src/management.ml

@@ -211,63 +211,3 @@ let update_master_signatures ~db_conn ~sm_signkey ~sm_denom
         Ok ())
   in
   Ok ()
-
-(* --- *)
-
-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
-
-let keys_get req server _env =
-  let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
-  let sm_denom = Vif.Server.device Devices.secmod_denom server in
-  let res =
-    let v = mk_future_keys_response ~sm_signkey ~sm_denom in
-    let s = Api.encode_exn Api.FutureKeysResponse.jsont v in
-    Ok s
-  in
-  respond_with_res res req
-
-let keys_post_jsont = MasterSignatures.jsont
-
-let keys_post req server _env =
-  let db_conn = Vif.Server.device Devices.db_connection server in
-  let sm_signkey = Vif.Server.device Devices.secmod_signkey server in
-  let sm_denom = Vif.Server.device Devices.secmod_denom server in
-  let res =
-    let open Syntax in
-    let* master_signatures =
-      match Vif.Request.of_json req with
-      | Ok (v : MasterSignatures.t) -> Ok v
-      | Error (`Msg msg) ->
-          Logs.err (fun m -> m "Invalid JSON: %s" msg);
-          Error msg
-    in
-    let* () =
-      verify_master_signatures ~sm_signkey ~sm_denom master_signatures
-    in
-    let* () =
-      update_master_signatures ~db_conn ~sm_signkey ~sm_denom master_signatures
-    in
-    Ok ""
-  in
-  respond_with_res res req

src/mte.ml

@@ -27,13 +27,13 @@ let routes =
   let get_ path = get (path /?? nil) in
   let post path jsont = post (json_encoding jsont) (path /?? nil) in
   let v s = rel / s in
+  let open Handler in
   [
     get_ rel --> hello;
     get_ (v "terms") --> Static.terms;
     get_ (v "privacy") --> Static.privacy;
-    get_ (v "management" / "keys") --> Management.keys_get;
+    get_ (v "management" / "keys") --> keys_get;
-    post (v "management" / "keys") Management.keys_post_jsont
+    post (v "management" / "keys") keys_post_jsont --> keys_post;
-    --> Management.keys_post;
   ]
 
 let () =