This commit is contained in:
swrup 2026-03-12 12:11:47 +01:00
parent 7ed875cd5e
commit 714997ec7b
4 changed files with 34 additions and 38 deletions

View file

@ -1,7 +1,7 @@
vendor_list := \ vendor_list := \
mkernel miou zarith bstr mnet mirage-crypto-rng-mkernel gmp digestif \ mkernel miou zarith bstr mnet mirage-crypto-rng-mkernel gmp digestif \
kdf utcp flux h1 httpcats mhttp multipart_form-miou prettym tls \ kdf utcp flux h1 httpcats mhttp multipart_form-miou prettym tls \
x509 vifu cachet mfat mirage-mtime caqti caqti-miou caqti-mnet caqti-driver-pgx x509 vifu cachet mfat mirage-mtime caqti
secmod_fat=secrets/secmod.fat secmod_fat=secrets/secmod.fat
tap_device=tap-mte tap_device=tap-mte

View file

@ -1,6 +1,7 @@
let db_connection caqti_switch : (unit, Caqti_miou.connection) Vif.Device.device = let db_connection caqti_switch : (unit, Caqti_miou.connection) Vif.Device.device
let f () = =
let db_uri= Config.Exchangedb_postgres.config in let f () =
let db_uri = Config.Exchangedb_postgres.config in
match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with match Caqti_miou_unix.connect ~sw:caqti_switch 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
@ -11,16 +12,19 @@ let f () =
| Ok () -> | Ok () ->
Logs.info (fun m -> m "database connection initialized"); Logs.info (fun m -> m "database connection initialized");
conn) conn)
in in
let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
Vif.Device.v ~name:"db_connection" ~finally [] f Vif.Device.v ~name:"db_connection" ~finally [] f
let keys storage = let keys storage =
let f (module Conn : Pg.CONN) () = let f (module Conn : Pg.CONN) () =
let (module Fs) = (module (struct let t = storage end)) in let (module Fs) =
let keys : (module Keys.S) = (module Keys.Make (Conn) (Fs) ) in (module struct
let t = storage
end)
in
let keys : (module Keys.S) = (module Keys.Make (Conn) (Fs)) in
keys keys
in in
let finally _key = () in let finally _key = () in
Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ] Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ] f
f

View file

@ -1,10 +1,7 @@
module Fat = Mfat.Make (struct module Fat = Mfat.Make (struct
include Mkernel.Block include Mkernel.Block
let read = atomic_read let read = atomic_read
let write = atomic_write let write = atomic_write
end) end)
@ -13,5 +10,5 @@ include Fat
type t = Mkernel.Block.t Mfat.t type t = Mkernel.Block.t Mfat.t
module type FS = sig module type FS = sig
val t : t val t : t
end end

View file

@ -83,17 +83,15 @@ let test (module Conn : Caqti_miou.CONNECTION) =
let disconnect (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () let disconnect (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect ()
module RNG = Mirage_crypto_rng.Fortuna module RNG = Mirage_crypto_rng.Fortuna
let () = let () =
let ( let@ ) finally fn = Fun.protect ~finally fn in let ( let@ ) finally fn = Fun.protect ~finally fn in
Util.Log_reporter.setup (); Util.Log_reporter.setup ();
let rng = let rng =
let rng () = Mirage_crypto_rng_mkernel.initialize (module RNG) in let rng () = Mirage_crypto_rng_mkernel.initialize (module RNG) in
Mkernel.map rng Mkernel.[] Mkernel.map rng Mkernel.[]
in in
let storage = Mkernel.storage ~name:"storage" in let storage = Mkernel.storage ~name:"storage" in
let service = let service =
let ipv4 = Ipaddr.V4.Prefix.of_string_exn "10.0.0.2/24" in let ipv4 = Ipaddr.V4.Prefix.of_string_exn "10.0.0.2/24" in
@ -122,17 +120,14 @@ in
Logs.app (fun m -> m "Test OK"); Logs.app (fun m -> m "Test OK");
(* -- *) (* -- *)
(* -- start webserver -- *) (* -- start webserver -- *)
let devices = [ let devices = [] in
]
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 in
let keys_device = Devices.keys storage (Vifu.Device.value db_device) in let keys_device = Devices.keys storage (Vifu.Device.value db_device) 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 ()
(*
(*
Miou_unix.run @@ fun () -> Miou_unix.run @@ fun () ->
Caqti_miou.Switch.run @@ fun caqti_switch -> Caqti_miou.Switch.run @@ fun caqti_switch ->
let env : Devices.env = let env : Devices.env =