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

MNET: wip devices

Browse source
This commit is contained in:
swrup 2026-03-12 12:08:21 +01:00
parent 832098dd58
commit 7ed875cd5e
6 changed files with 162 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/devices.ml
View file

@ -1,12 +1,6 @@
type env = {
caqti_switch: Caqti_miou.Switch.t;
db_uri: Uri.t;
}
let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
Vif.Device.v ~name:"db_connection" ~finally []
@@ fun { caqti_switch; db_uri } ->
let db_connection caqti_switch : (unit, Caqti_miou.connection) Vif.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
@ -17,10 +11,16 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
| Ok () ->
Logs.info (fun m -> m "database connection initialized");
conn)
in
let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
Vif.Device.v ~name:"db_connection" ~finally [] f
let keys =
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
Vif.Device.v ~name:"keys" ~finally [ Vif.Device.value db_connection ]
@@ fun (module Conn : Pg.CONN) (_env : env) ->
let keys : (module Keys.S) = (module Keys.Make (Conn)) in
keys
f