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)
(modules
fat
global
headers
respond
pg_type
pg
env
mte_device
mte_handler
mte
mte_terms
mte_info
mte_management
mte_handler
secmod_eddsa
secmod_rsa
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 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 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");
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
[connect_pool] with parameter [?post_connect] for preflight *)
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");
let db_uri = Config.Exchangedb_postgres.config in
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
let keys =
let f (module Conn : Pg.CONN) (env : env) =
let f (module Conn : Pg.CONN) (env : Env.t) =
let (module Fs : Fat.FS) =
(module struct
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 =
[
"auditors";
@ -20,7 +20,7 @@ let not_implemented_route : (string, Global.env) Vifu.Handler.t =
let open Vifu.Uri in
rel / prefix /% option rest /?? any)
in
fun req _v _server (_env : Global.env) ->
fun req _v _server _env ->
let target = Vifu.Request.target req in
Logs.debug (fun m -> m "not_implemented_route_handler `%s`" target);
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");
Respond.result req jsont
@@
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let* last_issue_date =
match Vifu.Queries.get req "last_issue_date" with
| [] -> Ok None

42
src/mte_management.ml
View file

@ -8,7 +8,7 @@ module Keys_get = struct
let f req server _env =
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
@@
let* v = Keys.make_future_keys_response () in
@ -37,7 +37,7 @@ module Keys_post = struct
Logs.info (fun m -> m "POST /management/keys/");
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* () = verify 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/");
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 =
DenominationHash.of_b32 h_denom_pub |> Result.map_error (fun e -> `Msg e)
in
@ -88,7 +88,7 @@ module Signkey_revoke = struct
Logs.info (fun m -> m "POST /management/signkeys/$EXCHANGE_PUB/revoke/");
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 =
Eddsa.pub_of_b32 exchange_pub |> Result.map_error (fun e -> `Msg e)
in
@ -140,8 +140,8 @@ module Auditors = struct
Logs.info (fun m -> m "POST /management/auditors/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in
let* () = verify keys 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/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* auditor_pub =
Eddsa.pub_of_b32 auditor_pub |> Result.map_error (fun e -> `Msg e)
in
@ -245,8 +245,8 @@ module Wire_fee = struct
Logs.info (fun m -> m "POST /management/wire-fee/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in
let* () = verify keys 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/");
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* () = verify v in
let* () = process ~db_conn v in
@ -404,8 +404,8 @@ module Wire = struct
Logs.info (fun m -> m "POST /management/wire/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in
let* () = verify keys 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/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in
let* () = verify keys v in
let* () = process ~db_conn v in
@ -487,8 +487,8 @@ module Drain = struct
Logs.info (fun m -> m "POST /management/drain/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in
let* () = verify keys v in
let* () = process ~db_conn v in
@ -526,8 +526,8 @@ module AmlOfficer = struct
Logs.info (fun m -> m "POST /management/aml-officers/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in
let* () = verify keys v in
let* () = process ~db_conn v in
@ -567,8 +567,8 @@ module Partners = struct
Logs.info (fun m -> m "POST /management/partners/");
Respond.result_no_content req
@@
let keys = Vifu.Server.device Global.keys server in
let db_conn = Vifu.Server.device Global.db_conn server in
let keys = Vifu.Server.device Mte_device.keys server in
let db_conn = Vifu.Server.device Mte_device.db_conn server in
let* v = request_of_json req in
let* () = verify keys v in
let* () = process ~db_conn v in