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

global.ml -> env.ml + mte_device.ml

Browse source
This commit is contained in:
swrup 2026-03-30 15:20:19 +02:00 • committed by Swrup
parent 0f4aa3f3f9
commit 34b979a9bc
7 changed files with 39 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/dune
View file

@ -2,16 +2,17 @@
(name mte) (name mte)
(modules (modules
fat fat
global
headers headers
respond respond
pg_type pg_type
pg pg
env
mte_device
mte_handler
mte mte
mte_terms mte_terms
mte_info mte_info
mte_management mte_management
mte_handler
secmod_eddsa secmod_eddsa
secmod_rsa secmod_rsa
keys keys

7
src/env.ml Normal file
View file

@ -0,0 +1,7 @@
type t = {
sw: Caqti_miou.Switch.t;
stack: Mnet.stack;
tcp: Mnet.TCP.state;
dns: Mnet_dns.t;
fs: Fat.t;
}

4
src/mte.ml
View file

@ -98,8 +98,8 @@ let () =
(* -- *) (* -- *)
let fs = Fat.create storage in let fs = Fat.create storage in
let cfg = Vifu.Config.v Config.Exchange.port in let cfg = Vifu.Config.v Config.Exchange.port in
let devices = Vifu.Devices.[ Global.db_conn; Global.keys ] in let devices = Vifu.Devices.[ Mte_device.db_conn; Mte_device.keys ] in
let handlers = [ Mte_handler.not_implemented_route ] in let handlers = [ Mte_handler.not_implemented_route ] in
let env = Global.{ sw; stack; tcp; dns; fs } in let env = { Env.sw; stack; tcp; dns; fs } in
Logs.info (fun m -> m "Starting MTE server"); Logs.info (fun m -> m "Starting MTE server");
Vifu.run ~cfg ~devices ~handlers tcp routes env Vifu.run ~cfg ~devices ~handlers tcp routes env

12
src/global.ml → src/mte_device.ml
View file

@ -1,15 +1,7 @@
type env = {
sw: Caqti_miou.Switch.t;
stack: Mnet.stack;
tcp: Mnet.TCP.state;
dns: Mnet_dns.t;
fs: Fat.t;
}
(* IMPROVE: use caqti pool (* IMPROVE: use caqti pool
[connect_pool] with parameter [?post_connect] for preflight *) [connect_pool] with parameter [?post_connect] for preflight *)
let db_conn = let db_conn =
let f { sw; stack; tcp; dns; fs= _ } = let f { Env.sw; stack; tcp; dns; fs= _ } =
Logs.info (fun m -> m "Connecting to database"); Logs.info (fun m -> m "Connecting to database");
let db_uri = Config.Exchangedb_postgres.config in let db_uri = Config.Exchangedb_postgres.config in
match Caqti_mnet.connect ~sw stack tcp dns db_uri with match Caqti_mnet.connect ~sw stack tcp dns db_uri with
@ -25,7 +17,7 @@ let db_conn =
Vifu.Device.v ~name:"db_conn" ~finally [] f Vifu.Device.v ~name:"db_conn" ~finally [] f
let keys = let keys =
let f (module Conn : Pg.CONN) (env : env) = let f (module Conn : Pg.CONN) (env : Env.t) =
let (module Fs : Fat.FS) = let (module Fs : Fat.FS) =
(module struct (module struct
let t = env.fs let t = env.fs

4
src/mte_handler.ml
View file

@ -1,4 +1,4 @@
let not_implemented_route : (string, Global.env) Vifu.Handler.t = let not_implemented_route : (string, Env.t) Vifu.Handler.t =
let uri_prefix_list = let uri_prefix_list =
[ [
"auditors"; "auditors";
@ -20,7 +20,7 @@ let not_implemented_route : (string, Global.env) Vifu.Handler.t =
let open Vifu.Uri in let open Vifu.Uri in
rel / prefix /% option rest /?? any) rel / prefix /% option rest /?? any)
in in
fun req _v _server (_env : Global.env) -> fun req _v _server _env ->
let target = Vifu.Request.target req in let target = Vifu.Request.target req in
Logs.debug (fun m -> m "not_implemented_route_handler `%s`" target); Logs.debug (fun m -> m "not_implemented_route_handler `%s`" target);
uri_prefix_list uri_prefix_list

4
src/mte_info.ml
View file

@ -162,8 +162,8 @@ let keys req server _env =
Logs.info (fun m -> m "GET /keys"); Logs.info (fun m -> m "GET /keys");
Respond.result req jsont Respond.result req jsont
@@ @@
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let* last_issue_date = let* last_issue_date =
match Vifu.Queries.get req "last_issue_date" with match Vifu.Queries.get req "last_issue_date" with
| [] -> Ok None | [] -> Ok None

42
src/mte_management.ml
View file

@ -8,7 +8,7 @@ module Keys_get = struct
let f req server _env = let f req server _env =
Logs.info (fun m -> m "GET /management/keys/"); Logs.info (fun m -> m "GET /management/keys/");
let (module Keys : Keys.S) = Vifu.Server.device Global.keys server in let (module Keys : Keys.S) = Vifu.Server.device Mte_device.keys server in
Respond.result req jsont Respond.result req jsont
@@ @@
let* v = Keys.make_future_keys_response () in let* v = Keys.make_future_keys_response () in
@ -37,7 +37,7 @@ module Keys_post = struct
Logs.info (fun m -> m "POST /management/keys/"); Logs.info (fun m -> m "POST /management/keys/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process keys v in let* () = process keys v in
@ -61,7 +61,7 @@ module Denom_revoke = struct
Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/"); Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let* h_denom_pub = let* h_denom_pub =
DenominationHash.of_b32 h_denom_pub |> Result.map_error (fun e -> `Msg e) DenominationHash.of_b32 h_denom_pub |> Result.map_error (fun e -> `Msg e)
in in
@ -88,7 +88,7 @@ module Signkey_revoke = struct
Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/"); Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let* exchange_pub = let* exchange_pub =
Eddsa.pub_of_b32 exchange_pub |> Result.map_error (fun e -> `Msg e) Eddsa.pub_of_b32 exchange_pub |> Result.map_error (fun e -> `Msg e)
in in
@ -140,8 +140,8 @@ module Auditors = struct
Logs.info (fun m -> m "POST /management/auditors/"); Logs.info (fun m -> m "POST /management/auditors/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process ~db_conn v in let* () = process ~db_conn v in
@ -183,8 +183,8 @@ module Auditors_disable = struct
Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/disable/"); Logs.info (fun m -> m "POST /management/auditors/$AUDITOR_PUB/disable/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* auditor_pub = let* auditor_pub =
Eddsa.pub_of_b32 auditor_pub |> Result.map_error (fun e -> `Msg e) Eddsa.pub_of_b32 auditor_pub |> Result.map_error (fun e -> `Msg e)
in in
@ -245,8 +245,8 @@ module Wire_fee = struct
Logs.info (fun m -> m "POST /management/wire-fee/"); Logs.info (fun m -> m "POST /management/wire-fee/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process ~db_conn v in let* () = process ~db_conn v in
@ -291,7 +291,7 @@ module Global_fees = struct
Logs.info (fun m -> m "POST /management/global-fees/"); Logs.info (fun m -> m "POST /management/global-fees/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify v in let* () = verify v in
let* () = process ~db_conn v in let* () = process ~db_conn v in
@ -404,8 +404,8 @@ module Wire = struct
Logs.info (fun m -> m "POST /management/wire/"); Logs.info (fun m -> m "POST /management/wire/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process ~db_conn v in let* () = process ~db_conn v in
@ -441,8 +441,8 @@ module Wire_disable = struct
Logs.info (fun m -> m "POST /management/wire/disable/"); Logs.info (fun m -> m "POST /management/wire/disable/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process ~db_conn v in let* () = process ~db_conn v in
@ -487,8 +487,8 @@ module Drain = struct
Logs.info (fun m -> m "POST /management/drain/"); Logs.info (fun m -> m "POST /management/drain/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process ~db_conn v in let* () = process ~db_conn v in
@ -526,8 +526,8 @@ module AmlOfficer = struct
Logs.info (fun m -> m "POST /management/aml-officers/"); Logs.info (fun m -> m "POST /management/aml-officers/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process ~db_conn v in let* () = process ~db_conn v in
@ -567,8 +567,8 @@ module Partners = struct
Logs.info (fun m -> m "POST /management/partners/"); Logs.info (fun m -> m "POST /management/partners/");
Respond.result_no_content req Respond.result_no_content req
@@ @@
let keys = Vifu.Server.device Global.keys server in let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in let* v = request_of_json req in
let* () = verify keys v in let* () = verify keys v in
let* () = process ~db_conn v in let* () = process ~db_conn v in