rm devices wip

This commit is contained in:
swrup 2026-03-12 13:23:27 +01:00
parent eff2cb8e67
commit e0fb96d64d
3 changed files with 34 additions and 50 deletions

View file

@ -1,30 +0,0 @@
let db_connection caqti_switch :
(unit, Caqti_miou.connection) Vifu.Device.device =
let f () =
let db_uri = Config.Exchangedb_postgres.config in
match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
| Error err ->
Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
| Ok conn -> (
match Pg.preflight conn with
| Error err ->
Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
| Ok () ->
Logs.info (fun m -> m "database connection initialized");
conn)
in
let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
Vifu.Device.v ~name:"db_connection" ~finally [] f
let keys storage =
let f (module Conn : Pg.CONN) () =
let (module Fs) =
(module struct
let t = storage
end)
in
let keys : (module Keys.S) = (module Keys.Make (Conn) (Fs)) in
keys
in
let finally _key = () in
Vifu.Device.v ~name:"keys" ~finally [ Vifu.Device.value db_connection ] f

View file

@ -81,8 +81,6 @@ let test (module Conn : Caqti_miou.CONNECTION) =
Logs.app (fun f -> f "%d - %d = %d" a b c);
()
let disconnect (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect ()
module RNG = Mirage_crypto_rng.Fortuna
let () =
@ -101,31 +99,42 @@ let () =
@@ fun rng storage (stack, tcp, udp) () ->
let@ () = fun () -> Mirage_crypto_rng_mkernel.kill rng in
let@ () = fun () -> Mnet.kill stack in
(* -- setup db connection -- *)
let hed, he = Mnet_happy_eyeballs.create tcp in
let@ () = fun () -> Mnet_happy_eyeballs.kill hed in
let dns = Mnet_dns.create (udp_db, he) in
let dns = Mnet_dns.create (udp, he) in
let t = Mnet_dns.transport dns in
let@ () = fun () -> Mnet_dns.Transport.kill t in
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
let db_conn =
let db_uri = Config.Exchangedb_postgres.config in
match Caqti_mnet.connect ~sw stack tcp dns db_uri with
| Error err ->
Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
| Ok conn -> conn
in
let@ () = fun () -> disconnect db_connection in
Logs.app (fun m -> m "Connected");
test db_connection;
Logs.app (fun m -> m "Test OK");
let@ () =
fun () ->
let (module Conn : Caqti_miou.CONNECTION) = db_conn in
Conn.disconnect ()
in
let () = Pg.preflight db_conn in
Logs.info (fun m -> m "database connection initialized");
let keys : (module Keys.S) =
let (module Conn : Pg.CONN) = db_conn in
let (module Fs : Fat.FS) =
(module struct
let t = storage
end)
in
(module Keys.Make (Conn) (Fs))
in
(* -- *)
(* -- start webserver -- *)
let devices = [] in
let cfg = Vifu.Config.v Config.Exchange.port in
let db_device = Devices.db_connection sw in
let keys_device = Devices.keys storage (Vifu.Device.value db_device) in
let devices = Vifu.Devices.[ db_device; keys_device ] in
Vifu.run ~cfg ~devices tcp routes ()
Vifu.run ~cfg tcp routes (db_conn, keys)
(*
Miou_unix.run @@ fun () ->

View file

@ -26,7 +26,12 @@ let preflight =
"SET search_path TO exchange;";
]
in
fun (module Conn : CONN) -> Syntax.list_iter (fun p -> Conn.exec p ()) l
fun (module Conn : CONN) ->
let r = Syntax.list_iter (fun p -> Conn.exec p ()) l in
match r with
| Error err ->
Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
| Ok () -> ()
let find_signkey =
let req =