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

Browse source
This commit is contained in:
swrup 2026-03-12 13:23:27 +01:00
parent eff2cb8e67
commit 7d135ebb06
2 changed files with 6 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/devices.ml
View file

@ -1,8 +1,8 @@
let db_connection caqti_switch : let db_connection caqti_switch stack state dns :
(unit, Caqti_miou.connection) Vifu.Device.device = (unit, Caqti_miou.connection) Vifu.Device.device =
let f () = let f () =
let db_uri = Config.Exchangedb_postgres.config in let db_uri = Config.Exchangedb_postgres.config in
match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with match Caqti_mnet.connect ~sw:caqti_switch stack state dns db_uri with
| Error err -> | Error err ->
Fmt.failwith "Database connection failure: %a." Caqti_error.pp err Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
| Ok conn -> ( | Ok conn -> (
@ -16,9 +16,9 @@ let db_connection caqti_switch :
let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
Vifu.Device.v ~name:"db_connection" ~finally [] f Vifu.Device.v ~name:"db_connection" ~finally [] f
let keys storage = let keys db_connection storage =
let f (module Conn : Pg.CONN) () = let f (module Conn : Pg.CONN) () =
let (module Fs) = let (module Fs : Fat.FS) =
(module struct (module struct
let t = storage let t = storage
end) end)

17
src/mte.ml
View file

@ -101,29 +101,16 @@ let () =
@@ fun rng storage (stack, tcp, udp) () -> @@ fun rng storage (stack, tcp, udp) () ->
let@ () = fun () -> Mirage_crypto_rng_mkernel.kill rng in let@ () = fun () -> Mirage_crypto_rng_mkernel.kill rng in
let@ () = fun () -> Mnet.kill stack in let@ () = fun () -> Mnet.kill stack in
(* -- setup db connection -- *)
let hed, he = Mnet_happy_eyeballs.create tcp in let hed, he = Mnet_happy_eyeballs.create tcp in
let@ () = fun () -> Mnet_happy_eyeballs.kill hed in let@ () = fun () -> Mnet_happy_eyeballs.kill hed in
let dns = Mnet_dns.create (udp_db, he) in let dns = Mnet_dns.create (udp_db, he) in
let t = Mnet_dns.transport dns in let t = Mnet_dns.transport dns in
let@ () = fun () -> Mnet_dns.Transport.kill t in let@ () = fun () -> Mnet_dns.Transport.kill t in
Caqti_miou.Switch.run @@ fun sw -> Caqti_miou.Switch.run @@ fun sw ->
Logs.app (fun m -> m "Connecting to the database");
let db_connection =
let config = Caqti_connect_config.default in
let r = Caqti_mnet.connect ~config ~sw stack tcp dns db_uri in
caqti_get_ok r
in
let@ () = fun () -> disconnect db_connection in
Logs.app (fun m -> m "Connected");
test db_connection;
Logs.app (fun m -> m "Test OK");
(* -- *)
(* -- start webserver -- *)
let devices = [] in let devices = [] in
let cfg = Vifu.Config.v Config.Exchange.port in let cfg = Vifu.Config.v Config.Exchange.port in
let db_device = Devices.db_connection sw in let db_device = Devices.db_connection sw stack tcp dns in
let keys_device = Devices.keys storage (Vifu.Device.value db_device) in let keys_device = Devices.keys db_device storage in
let devices = Vifu.Devices.[ db_device; keys_device ] in let devices = Vifu.Devices.[ db_device; keys_device ] in
Vifu.run ~cfg ~devices tcp routes () Vifu.run ~cfg ~devices tcp routes ()