swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

add handler.ml

Browse source
This commit is contained in:
swrup 2025-12-07 17:10:32 +01:00
parent 699e46c003
commit bcb9015c34
3 changed files with 60 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

60
src/management.ml
View file

@ -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