This commit is contained in:
swrup 2025-11-06 19:24:23 +01:00
parent 6318be5aad
commit 8ef2662f7f
3 changed files with 99 additions and 11 deletions

View file

@ -26,13 +26,58 @@ let alpn =
Mirage_runtime.register_arg
Arg.(value & opt_all (enum (List.map (fun v -> (v, v)) alpns)) alpns doc)
let pgx_database =
let doc = Arg.info ~doc:"database to use" [ "pg-database" ] in
Arg.(value & opt string "postgres" doc)
let pgx_port =
let doc = Arg.info ~doc:"port to use for postgresql" [ "pg-port" ] in
Arg.(value & opt int 5432 doc)
let pgx_hostname =
let doc = Arg.info ~doc:"host for postgres database" [ "pg-hostname" ] in
Arg.(required & opt (some string) None doc)
let pgx_user =
let doc = Arg.info ~doc:"postgres user" [ "pg-user" ] in
Arg.(required & opt (some string) None doc)
let pgx_password =
let doc = Arg.info ~doc:"postgres password" [ "pg-password" ] in
Arg.(required & opt (some string) None doc)
type t = {
pgx_database: string;
pgx_port: int;
pgx_hostname: string;
pgx_user: string;
pgx_password: string;
}
let pgx_setup =
Term.(
const (fun pgx_database pgx_port pgx_hostname pgx_user pgx_password ->
{ pgx_database; pgx_port; pgx_hostname; pgx_user; pgx_password })
$ pgx_database
$ pgx_port
$ pgx_hostname
$ pgx_user
$ pgx_password)
module Make
(Assets_ro : Mirage_kv.RO)
(Certificates_ro : Mirage_kv.RO)
(Keys_ro : Mirage_kv.RO)
(Tcp : Tcpip.Tcp.S with type ipaddr = Ipaddr.t)
(HTTP_server : Paf_mirage.S) =
(HTTP_server : Paf_mirage.S)
(STACK : Tcpip.Stack.V4V6)
(Happy_eyeballs :
Happy_eyeballs_mirage.S
with type stack = STACK.t
and type flow = STACK.TCP.flow) =
struct
module Pgx_mirage = Pgx_lwt_mirage.Make (STACK) (Happy_eyeballs)
let map_err_to_string pp_err res =
Lwt.map (R.reword_error (R.msgf "%a" pp_err)) res
@ -231,8 +276,20 @@ struct
let (`Initialized th) = Paf.serve http_1_1_service http_server in
th
let start assets_ro certificate_ro key_ro tcpv4v6 http_server =
let test_pgx { pgx_database; pgx_port; pgx_hostname; pgx_user; pgx_password }
pgx () =
let module Pgx = (val pgx : Pgx_lwt.S) in
Pgx.with_conn ~user:pgx_user ~host:pgx_hostname ~password:pgx_password
~port:pgx_port ~database:pgx_database (fun _conn ->
Logs.info (fun m -> m "Pgx.with_conn callback~~");
Lwt.return_unit)
let start assets_ro certificate_ro key_ro tcpv4v6 http_server stack
happy_eyeballs pgx_setup =
let open Lwt.Syntax in
Logs.(set_level (Some Info));
let pgx = Pgx_mirage.connect (stack, happy_eyeballs) in
let* () = test_pgx pgx_setup pgx () in
let* assets_res = Assets.assets assets_ro in
match assets_res with
| Error (`Msg m) -> Fmt.failwith "Assets configuration error: %s." m