From 462b1ad501f587d9546689936f805639a2615b34 Mon Sep 17 00:00:00 2001 From: swrup Date: Sun, 7 Dec 2025 17:10:32 +0100 Subject: [PATCH] --- src/handler.ml | 57 ++++++++++++++++++++++++++++++++++++++++++++ src/management.ml | 60 ----------------------------------------------- src/mte.ml | 6 ++--- 3 files changed, 60 insertions(+), 63 deletions(-) create mode 100644 src/handler.ml diff --git a/src/handler.ml b/src/handler.ml new file mode 100644 index 00000000..259592fe --- /dev/null +++ b/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 diff --git a/src/management.ml b/src/management.ml index 2f6d19f4..4386e4ad 100644 --- a/src/management.ml +++ b/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 diff --git a/src/mte.ml b/src/mte.ml index 70868221..b164d851 100644 --- a/src/mte.ml +++ b/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; - post (v "management" / "keys") Management.keys_post_jsont - --> Management.keys_post; + get_ (v "management" / "keys") --> keys_get; + post (v "management" / "keys") keys_post_jsont --> keys_post; ] let () =