pgx

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
 
@@ -67,7 +112,7 @@ struct
       in
       Lwt.return
       @@
-      let open Result.Syntax in
+      let ( let* ) = Result.bind in
       let* l =
         list_get_ok
         @@ List.map
@@ -127,7 +172,7 @@ struct
       let*? privacy_etag, privacy_lang_l, privacy_ext_l = get ro "privacy" in
       Lwt.return
       @@
-      let open Result.Syntax in
+      let ( let* ) = Result.bind in
       let* lang_l =
         match terms_lang_l = privacy_lang_l with
         | false ->
@@ -231,8 +276,25 @@ 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 start assets_ro certificate_ro key_ro tcpv4v6 http_server stack
+      happy_eyeballs pgx_setup =
+    Logs.set_reporter (Logs_fmt.reporter ());
+    Logs.(set_level (Some Info));
     let open Lwt.Syntax in
+    let pgx = Pgx_mirage.connect (stack, happy_eyeballs) in
+    let module Pgx = (val pgx : Pgx_lwt.S) in
+    let { pgx_database; pgx_port; pgx_hostname; pgx_user; pgx_password } =
+      pgx_setup
+    in
+    Pgx.with_conn ~user:pgx_user ~host:pgx_hostname ~password:pgx_password
+      ~port:pgx_port ~database:pgx_database
+    @@ fun pgx_conn ->
+    let* () =
+      let+ alive = Pgx.alive pgx_conn in
+      match alive with
+      | false -> Fmt.failwith "Pgx connection failure: connection not alive"
+      | true -> Logs.info (fun m -> m "Pgx connection success")
+    in
     let* assets_res = Assets.assets assets_ro in
     match assets_res with
     | Error (`Msg m) -> Fmt.failwith "Assets configuration error: %s." m