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

Browse source
This commit is contained in:
swrup 2025-11-07 17:34:27 +01:00
parent 0b01ef8871
commit 606e4750e0
6 changed files with 13 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -1,4 +1,4 @@
# Generated by mirage.v4.10.3 # Generated by mirage.v4.10.1
-include Makefile.user -include Makefile.user
BUILD_DIR = unikernel/ BUILD_DIR = unikernel/

2
dune-project
View file

@ -4,4 +4,4 @@
(implicit_transitive_deps true) (implicit_transitive_deps true)
;; Generated by mirage.v4.10.3 ;; Generated by mirage.v4.10.1

2
dune-workspace
View file

@ -2,4 +2,4 @@
(context (default)) (context (default))
;; Generated by mirage.v4.10.3 ;; Generated by mirage.v4.10.1

6
unikernel/config.ml
View file

@ -6,9 +6,9 @@ let packages =
[ [
package "digestif"; package ~min:"0.0.9" "mimic-happy-eyeballs"; package "digestif"; package ~min:"0.0.9" "mimic-happy-eyeballs";
package "hxd" ~sublibs:[ "core"; "string" ]; package "rresult"; package "hxd" ~sublibs:[ "core"; "string" ]; package "rresult";
package "h2" ~min:"0.13.0"; package "pgx"; package "pgx_lwt"; package ~min:"0.13.0" "h2"; package ~min:"10.0.0" "dns-client";
package "pgx_lwt_mirage"; package "logs"; package "mirage-logs"; package "pgx"; package "pgx_lwt"; package "pgx_lwt_mirage"; package "logs";
package "conduit"; package "duration"; package "mirage-logs"; package "conduit"; package "duration";
] ]
let mte = let mte =

2
unikernel/dune
View file

@ -1,3 +1,3 @@
;; Generated by mirage.v4.10.3 ;; Generated by mirage.v4.10.1
(include dune.build) (include dune.build)

12
unikernel/unikernel.ml
View file

@ -112,7 +112,7 @@ struct
in in
Lwt.return Lwt.return
@@ @@
let open Result.Syntax in let ( let* ) = Result.bind in
let* l = let* l =
list_get_ok list_get_ok
@@ List.map @@ List.map
@ -172,7 +172,7 @@ struct
let*? privacy_etag, privacy_lang_l, privacy_ext_l = get ro "privacy" in let*? privacy_etag, privacy_lang_l, privacy_ext_l = get ro "privacy" in
Lwt.return Lwt.return
@@ @@
let open Result.Syntax in let ( let* ) = Result.bind in
let* lang_l = let* lang_l =
match terms_lang_l = privacy_lang_l with match terms_lang_l = privacy_lang_l with
| false -> | false ->
@ -268,7 +268,7 @@ struct
let+ (), () = Lwt.both th0 th1 in let+ (), () = Lwt.both th0 th1 in
() ()
let run http_server = let run ~pgx_conn:_ http_server =
let http_1_1_service = let http_1_1_service =
HTTP_server.http_service ~error_handler:Server.http_1_1_error_handler HTTP_server.http_service ~error_handler:Server.http_1_1_error_handler
http_1_1_request_handler http_1_1_request_handler
@ -288,9 +288,9 @@ struct
in in
Pgx.with_conn ~user:pgx_user ~host:pgx_hostname ~password:pgx_password Pgx.with_conn ~user:pgx_user ~host:pgx_hostname ~password:pgx_password
~port:pgx_port ~database:pgx_database ~port:pgx_port ~database:pgx_database
@@ fun conn -> @@ fun pgx_conn ->
let* () = let* () =
let+ alive = Pgx.alive conn in let+ alive = Pgx.alive pgx_conn in
match alive with match alive with
| false -> Fmt.failwith "Pgx connection failure: connection not alive" | false -> Fmt.failwith "Pgx connection failure: connection not alive"
| true -> Logs.info (fun m -> m "Pgx connection success") | true -> Logs.info (fun m -> m "Pgx connection success")
@ -301,7 +301,7 @@ struct
| Ok (_terms_etag, _privacy_etag, _lang_l, _ext_l) -> ( | Ok (_terms_etag, _privacy_etag, _lang_l, _ext_l) -> (
let* tls_res = tls certificate_ro key_ro in let* tls_res = tls certificate_ro key_ro in
match use_tls () with match use_tls () with
| false -> run http_server | false -> run ~pgx_conn http_server
| true -> ( | true -> (
match tls_res with match tls_res with
| Error (`Msg m) -> | Error (`Msg m) ->