This commit is contained in:
parent
7ed875cd5e
commit
714997ec7b
4 changed files with 34 additions and 38 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -1,26 +1,30 @@
|
||||||
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 () =
|
||||||
match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
|
let db_uri = Config.Exchangedb_postgres.config in
|
||||||
| Error err ->
|
match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
|
||||||
Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
|
| Error err ->
|
||||||
| Ok conn -> (
|
Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
|
||||||
match Pg.preflight conn with
|
| Ok conn -> (
|
||||||
| Error err ->
|
match Pg.preflight conn with
|
||||||
Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
|
| Error err ->
|
||||||
| Ok () ->
|
Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
|
||||||
Logs.info (fun m -> m "database connection initialized");
|
| Ok () ->
|
||||||
conn)
|
Logs.info (fun m -> m "database connection initialized");
|
||||||
in
|
conn)
|
||||||
|
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
|
||||||
keys
|
let t = storage
|
||||||
in
|
end)
|
||||||
|
in
|
||||||
|
let keys : (module Keys.S) = (module Keys.Make (Conn) (Fs)) in
|
||||||
|
keys
|
||||||
|
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
|
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
19
src/mte.ml
19
src/mte.ml
|
|
@ -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 =
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue