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

+ s/Vif/Vifu/

Browse source
This commit is contained in:
swrup 2026-03-12 12:23:57 +01:00
parent 69755537f6
commit 96f10ec373
7 changed files with 57 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/devices.ml
View file

@ -1,4 +1,4 @@
let db_connection caqti_switch : (unit, Caqti_miou.connection) Vif.Device.device
let db_connection caqti_switch : (unit, Caqti_miou.connection) Vifu.Device.device
=
let f () =
let db_uri = Config.Exchangedb_postgres.config in
@ -14,7 +14,7 @@ let db_connection caqti_switch : (unit, Caqti_miou.connection) Vif.Device.device
conn)
in
let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
Vif.Device.v ~name:"db_connection" ~finally [] f
Vifu.Device.v ~name:"db_connection" ~finally [] f
let keys storage =
let f (module Conn : Pg.CONN) () =
@ -27,4 +27,4 @@ let keys storage =
keys
in
let finally _key = () in
Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ] f
Vifu.Device.v ~name:"keys" ~finally [ Vifu.Device.value db_connection ] f

6
src/headers.ml
View file

@ -9,7 +9,7 @@ let avail_languages_header_value =
(* TODO better headers_lib
Cohttp raises on invalid *)
let select_mimetype headers =
let opt = Vif.Headers.get headers "accept" in
let opt = Vifu.Headers.get headers "accept" in
Cohttp.Accept.media_ranges opt
|> Cohttp.Accept.qsort
|> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp m)
@ -18,7 +18,7 @@ let select_mimetype headers =
| Some mime -> mime
let select_language headers =
let opt = Vif.Headers.get headers "accept-language" in
let opt = Vifu.Headers.get headers "accept-language" in
Cohttp.Accept.languages opt
|> Cohttp.Accept.qsort
|> List.map snd
@ -28,7 +28,7 @@ let select_language headers =
| Some lang -> lang
let select_encoding headers =
let opt = Vif.Headers.get headers "accept-encoding" in
let opt = Vifu.Headers.get headers "accept-encoding" in
Cohttp.Accept.encodings opt
|> Cohttp.Accept.qsort
|> List.map snd

14
src/mte.ml
View file

@ -14,17 +14,17 @@
along with this program. If not, see <https://www.gnu.org/licenses/>. *)
let hello req _server _env =
let open Vif.Response in
let open Vifu.Response in
let open Syntax in
let* () = with_string req "Hello~~\n" in
let* () = add ~field:"content-type" "text/plain" in
respond `OK
let routes =
let open Vif.Uri in
let open Vif.Route in
let open Vifu.Uri in
let open Vifu.Route in
let get path = get (path /?? any) in
let post path jsont = post (Vif.Type.json_encoding jsont) (path /?? any) in
let post path jsont = post (Vifu.Type.json_encoding jsont) (path /?? any) in
let v s = rel / s in
let tos =
[
@ -133,9 +133,9 @@ let () =
let env : Devices.env =
{ caqti_switch; db_uri= Config.Exchangedb_postgres.config }
in
let devices = Vif.Devices.[ Devices.db_connection; Devices.keys ] in
let middlewares = Vif.Middlewares.[] in
let devices = Vifu.Devices.[ Devices.db_connection; Devices.keys ] in
let middlewares = Vifu.Middlewares.[] in
Logs.info (fun m ->
m ~tags:(Util.Log_reporter.detail "...") "Starting MTE server");
Vif.run ~cfg ~devices ~middlewares routes env
Vifu.run ~cfg ~devices ~middlewares routes env
*)

10
src/mte_info.ml
View file

@ -7,9 +7,9 @@ module String_map = Stdlib.Map.Make (Stdlib.String)
maybe don't use the same RNG-initialization as the one used to generate keys *)
let seed req _server _env =
Logs.info (fun m -> m "GET /seed");
(* RNG is initialized by Vif.run *)
(* RNG is initialized by Vifu.run *)
let s = Mirage_crypto_rng.generate 64 in
let open Vif.Response in
let open Vifu.Response in
let open Syntax in
let* () = add ~field:"content-type" "application/octet-stream" in
let* () = with_string req s in
@ -158,11 +158,11 @@ let jsont = ExchangeKeysResponse.jsont
let keys req server _env =
Logs.info (fun m -> m "GET /keys");
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let res =
let* last_issue_date =
match Vif.Queries.get req "last_issue_date" with
match Vifu.Queries.get req "last_issue_date" with
| [] -> Ok None
| s :: _ -> (
match Int64.of_string_opt s with

66
src/mte_management.ml
View file

@ -7,7 +7,7 @@ module Keys_get = struct
let f req server _env =
Logs.info (fun m -> m "GET /management/keys/");
let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
let (module Keys : Keys.S) = Vifu.Server.device Devices.keys server in
let res =
let* v = Keys.make_future_keys_response () in
Api.encode jsont v
@ -31,9 +31,9 @@ module Keys_post = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/keys/");
let keys = Vif.Server.device Devices.keys server in
let keys = Vifu.Server.device Devices.keys server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ keys v in
Ok ()
@ -56,10 +56,10 @@ module Denom_revoke = struct
let f req h_denom_pub server _env =
Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
let keys = Vif.Server.device Devices.keys server in
let keys = Vifu.Server.device Devices.keys server in
let res =
let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys h_denom_pub v in
let* () = do_ keys h_denom_pub v in
Ok ()
@ -82,10 +82,10 @@ module Signkey_revoke = struct
let f req exchange_pub server _env =
Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
let keys = Vif.Server.device Devices.keys server in
let keys = Vifu.Server.device Devices.keys server in
let res =
let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys exchange_pub v in
let* () = do_ keys exchange_pub v in
Ok ()
@ -133,10 +133,10 @@ module Auditors = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/auditors/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ()
@ -178,11 +178,11 @@ module Auditors_disable = struct
let f req auditor_pub server _env =
Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/disable/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys auditor_pub v in
let* () = do_ ~db_conn auditor_pub v in
Ok ()
@ -238,10 +238,10 @@ module Wire_fee = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/wire-fee/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ()
@ -284,9 +284,9 @@ module Global_fees = struct
and once set for a timeframe, it should not change. *)
let f req server _env =
Logs.info (fun m -> m "POST /management/global-fees/");
let db_conn = Vif.Server.device Devices.db_connection server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify v in
let* () = do_ ~db_conn v in
Ok ()
@ -399,10 +399,10 @@ module Wire = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/wire/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ()
@ -438,10 +438,10 @@ module Wire_disable = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/wire/disable/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ()
@ -487,10 +487,10 @@ module Drain = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/drain/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ()
@ -527,10 +527,10 @@ module AmlOfficer = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/aml-officers/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ()
@ -569,10 +569,10 @@ module Partners = struct
let f req server _env =
Logs.info (fun m -> m "POST /management/partners/");
let keys = Vif.Server.device Devices.keys server in
let db_conn = Vif.Server.device Devices.db_connection server in
let keys = Vifu.Server.device Devices.keys server in
let db_conn = Vifu.Server.device Devices.db_connection server in
let res =
let* v = Vif.Request.of_json req |> unwrap_msg in
let* v = Vifu.Request.of_json req |> unwrap_msg in
let* () = verify keys v in
let* () = do_ ~db_conn v in
Ok ()

6
src/mte_terms.ml
View file

@ -2,9 +2,9 @@
let aux asset req _server _env =
let etag = Assets.etag asset in
let headers = Vif.Request.headers req in
let headers = Vifu.Request.headers req in
let has_matching_etag =
match Vif.Headers.get headers "if-none-match" with
match Vifu.Headers.get headers "if-none-match" with
| None -> Ok false
| Some s ->
Headers_lib.If_none_match.parse s
@ -19,7 +19,7 @@ let aux asset req _server _env =
let compression = Headers.select_encoding headers in
let data = Assets.get_content ~mime ~lang asset in
(* -- *)
let open Vif.Response in
let open Vifu.Response in
let open Syntax in
let* () = with_string ?compression req data in
let* () =

6
src/respond.ml
View file

@ -4,7 +4,7 @@ let encode_error_detail err =
| Ok s -> s
let respond_json req content status =
let open Vif.Response in
let open Vifu.Response in
let open Syntax in
let* () = add ~field:"content-type" "application/json" in
let* () = with_string req content in
@ -32,14 +32,14 @@ let ok content req =
let no_content () =
Logs.debug (fun m -> m "no content");
let open Vif.Response in
let open Vifu.Response in
let open Syntax in
let* () = empty in
respond `No_content
let not_modified () =
Logs.debug (fun m -> m "not modified");
let open Vif.Response in
let open Vifu.Response in
let open Syntax in
let* () = empty in
respond `Not_modified