From 6b5a127b1f944c3f883902fff122f0723110ffa2 Mon Sep 17 00:00:00 2001
From: swrup <swrup@protonmail.com>
Date: Thu, 6 Nov 2025 19:24:23 +0100
Subject: [PATCH] pgx

---
 README.md              |  6 +++++
 unikernel/config.ml    | 48 ++++++++++++++++++++++++---------
 unikernel/unikernel.ml | 61 ++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 101 insertions(+), 14 deletions(-)

diff --git a/README.md b/README.md
index d84f96b2..bd1cb864 100644
--- a/README.md
+++ b/README.md
@@ -7,4 +7,10 @@ $ mirage configure -f unikernel/config.ml -t unix
 $ gen_tls.sh foo
 $ make
 
+run:
+./unikernel/dist/mte --pg-database taler-exchange --pg-port 5432 --pg-hostname localhost --pg-user mte --pg-password xxx
 
+todo
+  - make a .opam file
+  - pin pgx to:
+    "git+https://github.com/pgx-ocaml/pgx.git#57c39ad93b712b4a9c1914be0c99172e050bc8e9"
diff --git a/unikernel/config.ml b/unikernel/config.ml
index 5051bfcb..639cc5a0 100644
--- a/unikernel/config.ml
+++ b/unikernel/config.ml
@@ -1,20 +1,33 @@
-(* mirage >= 4.9.0 & < 4.11.0 *)
 open Mirage
 
+let pgx_setup = runtime_arg ~pos:__POS__ "Unikernel.pgx_setup"
+
+let packages =
+  [
+    package "digestif"; package ~min:"0.0.9" "mimic-happy-eyeballs";
+    package "hxd" ~sublibs:[ "core"; "string" ]; package "rresult";
+    package "h2" ~min:"0.13.0"; package "pgx"; package "pgx_lwt";
+    package "pgx_lwt_mirage"; package "logs"; package "mirage-logs";
+    package "conduit"; package "duration";
+  ]
+
 let mte =
-  main "Unikernel.Make" ~local_libs:[ "mte" ]
-    ~packages:
-      [
-        package "digestif"; package ~min:"0.0.9" "mimic-happy-eyeballs";
-        package "hxd" ~sublibs:[ "core"; "string" ]; package "rresult";
-        package "h2" ~min:"0.13.0"; package "base64" ~sublibs:[ "rfc2045" ];
-      ]
-    (kv_ro @-> kv_ro @-> kv_ro @-> tcpv4v6 @-> http_server @-> job)
+  main "Unikernel.Make" ~local_libs:[ "mte" ] ~packages
+    ~runtime_args:[ pgx_setup ]
+    (kv_ro
+    @-> kv_ro
+    @-> kv_ro
+    @-> tcpv4v6
+    @-> http_server
+    @-> stackv4v6
+    @-> happy_eyeballs
+    @-> job)
 
 let stackv4v6 = generic_stackv4v6 default_network
 let tcpv4v6 = tcpv4v6_of_stackv4v6 stackv4v6
-let he = generic_happy_eyeballs stackv4v6
-let dns = generic_dns_client stackv4v6 he
+let happy_eyeballs = generic_happy_eyeballs stackv4v6
+
+(*let dns = generic_dns_client stackv4v6 happy_eyeballs*)
 let certificates = crunch "../data/tls/certificates"
 let keys = crunch "../data/tls/keys"
 let assets = crunch "../data/assets"
@@ -22,4 +35,15 @@ let port = Runtime_arg.create ~pos:__POS__ "Unikernel.port"
 let http_server = paf_server ~port tcpv4v6
 
 let () =
-  register "mte" [ mte $ assets $ certificates $ keys $ tcpv4v6 $ http_server ]
+  register "mte"
+    [
+      mte
+      $ assets
+      $ certificates
+      $ keys
+      $ tcpv4v6
+      $ http_server
+      (* TODO maybe we can avoid to repeat the stack? *)
+      $ stackv4v6
+      $ happy_eyeballs;
+    ]
diff --git a/unikernel/unikernel.ml b/unikernel/unikernel.ml
index 853896e9..c9345278 100644
--- a/unikernel/unikernel.ml
+++ b/unikernel/unikernel.ml
@@ -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