Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

sans cstruct #80

Merged
merged 1 commit into from
Sep 4, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions async/gluten_async.ml
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ module Make_IO_Loop (Io : Gluten_async_intf.IO) = struct
Buffer.put
~f:(fun buf ~off ~len k -> Async.upon (Io.read socket buf ~off ~len) k)
read_buffer
(fun n -> (Ivar.fill [@alert "-deprecated"]) ivar n);
(fun n -> (Ivar.fill [@ocaml.alert "-deprecated"]) ivar n);
Ivar.read ivar

let start :
Expand Down Expand Up @@ -76,7 +76,7 @@ module Make_IO_Loop (Io : Gluten_async_intf.IO) = struct
Runtime.yield_reader t reader_thread;
Deferred.return ()
| `Close ->
(Ivar.fill [@alert "-deprecated"]) read_complete ();
(Ivar.fill [@ocaml.alert "-deprecated"]) read_complete ();
Io.shutdown_receive socket;
Deferred.return ()
in
Expand All @@ -91,7 +91,7 @@ module Make_IO_Loop (Io : Gluten_async_intf.IO) = struct
Runtime.report_write_result t result;
writer_thread ()
| `Yield -> Runtime.yield_writer t writer_thread
| `Close _ -> (Ivar.fill [@alert "-deprecated"]) write_complete ()
| `Close _ -> (Ivar.fill [@ocaml.alert "-deprecated"]) write_complete ()
in
let conn_monitor = Monitor.create () in
Scheduler.within ~monitor:conn_monitor reader_thread;
Expand Down
4 changes: 2 additions & 2 deletions async/ssl_io.real.ml
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,7 @@ let connect r w =
don't_wait_for
( closed_and_flushed >>= fun () ->
Reader.close_finished app_reader >>| fun () ->
Writer.close w >>> (Ivar.fill [@alert "-deprecated"]) closed_ivar );
Writer.close w >>> (Ivar.fill [@ocaml.alert "-deprecated"]) closed_ivar );
let reader = app_reader in
let writer = app_writer in
reader, writer, Ivar.read closed_ivar
Expand Down Expand Up @@ -142,7 +142,7 @@ let listen ~crt_file ~key_file r w =
don't_wait_for
( closed_and_flushed >>= fun () ->
Reader.close_finished app_reader >>| fun () ->
Writer.close w >>> (Ivar.fill [@alert "-deprecated"]) closed_ivar );
Writer.close w >>> (Ivar.fill [@ocaml.alert "-deprecated"]) closed_ivar );
let reader = app_reader in
let writer = app_writer in
reader, writer, Ivar.read closed_ivar
Expand Down
8 changes: 6 additions & 2 deletions async/tls_io.real.ml
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ let connect :
don't_wait_for
( Deferred.all_unit
[ Reader.close_finished reader; Writer.close_finished writer ]
>>| fun () -> (Ivar.fill [@alert "-deprecated"]) closed () );
>>| fun () -> (Ivar.fill [@ocaml.alert "-deprecated"]) closed () );
return (reader, writer, Ivar.read closed)

let null_auth ?ip:_ ~host:_ _ = Ok None
Expand All @@ -110,7 +110,11 @@ let make_default_client :
-> 'b descriptor Deferred.t
=
fun ?alpn_protocols ?host socket where_to_connect ->
let config = Tls.Config.client ?alpn_protocols ~authenticator:null_auth () in
let config =
Tls.Config.client ?alpn_protocols ~authenticator:null_auth ()
|> Result.ok
|> Option.value_exn
in
connect ~config ~socket ~where_to_connect ~host

(* let make_server ?alpn_protocols ~certfile ~keyfile _socket =
Expand Down
12 changes: 7 additions & 5 deletions dune-project
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,8 @@
(depopts
(lwt_ssl
(>= "1.2.0"))
tls-lwt))
(tls-lwt
(>= "1.0.0"))))

(package
(name gluten-mirage)
Expand All @@ -72,9 +73,7 @@
(conduit-mirage
(>= "2.0.2"))
(mirage-flow
(>= "2.0.0"))
(cstruct
(>= "6.0.0"))))
(>= "2.0.0"))))

(package
(name gluten-async)
Expand All @@ -90,7 +89,10 @@
(>= "v0.15.0"))
(core
(>= "v0.15.0")))
(depopts async_ssl tls-async))
(depopts
async_ssl
(tls-async
(>= "1.0.0"))))

(package
(name gluten-eio)
Expand Down
14 changes: 7 additions & 7 deletions flake.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 7 additions & 2 deletions flake.nix
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,12 @@
in
{
packages = packages // { default = packages.gluten; };
devShells.default = pkgs.callPackage ./shell.nix { inherit packages; };
devShells.release = pkgs.callPackage ./shell.nix { inherit packages; release-mode = true; };
devShells = {
default = pkgs.callPackage ./nix/shell.nix { inherit packages; };
release = pkgs.callPackage ./nix/shell.nix {
inherit packages;
release-mode = true;
};
};
});
}
5 changes: 4 additions & 1 deletion gluten-async.opam
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,10 @@ depends: [
"core" {>= "v0.15.0"}
"odoc" {with-doc}
]
depopts: ["async_ssl" "tls-async"]
depopts: [
"async_ssl"
"tls-async" {>= "1.0.0"}
]
build: [
["dune" "subst"] {dev}
[
Expand Down
2 changes: 1 addition & 1 deletion gluten-lwt-unix.opam
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ depends: [
]
depopts: [
"lwt_ssl" {>= "1.2.0"}
"tls-lwt"
"tls-lwt" {>= "1.0.0"}
]
build: [
["dune" "subst"] {dev}
Expand Down
1 change: 0 additions & 1 deletion gluten-mirage.opam
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ depends: [
"faraday-lwt" {>= "0.7.3"}
"conduit-mirage" {>= "2.0.2"}
"mirage-flow" {>= "2.0.0"}
"cstruct" {>= "6.0.0"}
"odoc" {with-doc}
]
build: [
Expand Down
18 changes: 11 additions & 7 deletions lwt-unix/tls_io.real.ml
Original file line number Diff line number Diff line change
Expand Up @@ -57,14 +57,14 @@ struct
let writev tls iovecs =
Lwt.catch
(fun () ->
let cstruct_iovecs =
List.map
(fun { Faraday.len; buffer; off } ->
Cstruct.of_bigarray ~off ~len buffer)
let lenv, cstruct_iovecs =
List.fold_left_map
(fun acc { Faraday.len; buffer; off } ->
acc + len, Bigstringaf.substring buffer ~off ~len)
0
iovecs
in
Tls_lwt.Unix.writev tls cstruct_iovecs >|= fun () ->
`Ok (Cstruct.lenv cstruct_iovecs))
Tls_lwt.Unix.writev tls cstruct_iovecs >|= fun () -> `Ok lenv)
(function
| Unix.Unix_error (Unix.EBADF, "check_descriptor", _) ->
Lwt.return `Closed
Expand All @@ -76,13 +76,17 @@ end
let null_auth ?ip:_ ~host:_ _ = Ok None

let make_client ?alpn_protocols socket =
let config = Tls.Config.client ?alpn_protocols ~authenticator:null_auth () in
let config =
Tls.Config.client ?alpn_protocols ~authenticator:null_auth ()
|> Result.get_ok
in
Tls_lwt.Unix.client_of_fd config socket

let make_server ?alpn_protocols ~certfile ~keyfile socket =
X509_lwt.private_of_pems ~cert:certfile ~priv_key:keyfile
>>= fun certificate ->
let config =
Tls.Config.server ?alpn_protocols ~certificates:(`Single certificate) ()
|> Result.get_ok
in
Tls_lwt.Unix.server_of_fd config socket
4 changes: 1 addition & 3 deletions mirage/dune
Original file line number Diff line number Diff line change
@@ -1,6 +1,4 @@
(library
(name gluten_mirage)
(public_name gluten-mirage)
(libraries faraday-lwt gluten-lwt lwt mirage-flow cstruct)
(flags
(:standard -safe-string)))
(libraries faraday-lwt gluten-lwt lwt mirage-flow))
1 change: 1 addition & 0 deletions nix/default.nix
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ let
faraday-lwt-unix
gluten-lwt
lwt_ssl
tls-lwt
];
};

Expand Down
File renamed without changes.
Loading