diff --git a/CHANGES.md b/CHANGES.md index 1ebbea2a..de42d131 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -## v0.16.1 (2023-03-01) +## v0.17.0 (2023-03-01) * tls-async: remove ocaml < 5.0.0 constraint (#471 #474 @hannesm) * remove dependency on ppx, especially ppx_cstruct and ppx_sexp_conv across diff --git a/async/io.ml b/async/io.ml index bb62b46e..a639c27a 100644 --- a/async/io.ml +++ b/async/io.ml @@ -11,7 +11,7 @@ module Tls_error = struct module Fail = struct type t = Tls.Engine.failure let sexp_of_t a = - Sexplib.Sexp.Atom (Fmt.to_to_string Tls.Engine.pp_failure a) + Sexplib.Sexp.Atom (Tls.Engine.string_of_failure a) end type t = | Tls_alert of Alert.t diff --git a/eio/tls_eio.ml b/eio/tls_eio.ml index 70ccc198..2e4eaab9 100644 --- a/eio/tls_eio.ml +++ b/eio/tls_eio.ml @@ -228,5 +228,5 @@ let () = | Tls_alert typ -> Some ("TLS alert from peer: " ^ Tls.Packet.alert_type_to_string typ) | Tls_failure f -> - Some ("TLS failure: " ^ Fmt.to_to_string Tls.Engine.pp_failure f) + Some ("TLS failure: " ^ Tls.Engine.string_of_failure f) | _ -> None) diff --git a/lib/engine.ml b/lib/engine.ml index 5c9553e7..2565ae9f 100644 --- a/lib/engine.ml +++ b/lib/engine.ml @@ -78,6 +78,8 @@ let alert_of_failure = function let pp_failure = State.pp_failure +let string_of_failure = Fmt.to_to_string pp_failure + type ret = ([ `Ok of state | `Eof | `Alert of Packet.alert_type ] * [ `Response of Cstruct.t option ] diff --git a/lib/engine.mli b/lib/engine.mli index aa3ed4d2..ee4172f0 100644 --- a/lib/engine.mli +++ b/lib/engine.mli @@ -132,6 +132,9 @@ type failure = [ (** [alert_of_failure failure] is [alert], the TLS alert type for this failure. *) val alert_of_failure : failure -> Packet.alert_type +(** [string_of_failure failure] is [string], the string representation of the [failure]. *) +val string_of_failure : failure -> string + (** [pp_failure failure] pretty-prints failure. *) val pp_failure : failure Fmt.t diff --git a/lwt/examples/echo_server.ml b/lwt/examples/echo_server.ml index 8ba0e9db..fa862291 100644 --- a/lwt/examples/echo_server.ml +++ b/lwt/examples/echo_server.ml @@ -28,7 +28,7 @@ let serve_ssl port callback = | Tls_lwt.Tls_alert a -> yap ~tag @@ "handler: " ^ Tls.Packet.alert_type_to_string a | Tls_lwt.Tls_failure a -> - yap ~tag @@ "handler: " ^ Fmt.to_to_string Tls.Engine.pp_failure a + yap ~tag @@ "handler: " ^ Tls.Engine.string_of_failure a | Unix.Unix_error (e, f, p) -> yap ~tag @@ "handler: " ^ (string_of_unix_err e f p) | _exn -> yap ~tag "handler: exception") @@ -43,7 +43,7 @@ let serve_ssl port callback = (function | Unix.Unix_error (e, f, p) -> return (`L (string_of_unix_err e f p)) | Tls_lwt.Tls_alert a -> return (`L (Tls.Packet.alert_type_to_string a)) - | Tls_lwt.Tls_failure f -> return (`L (Fmt.to_to_string Tls.Engine.pp_failure f)) + | Tls_lwt.Tls_failure f -> return (`L (Tls.Engine.string_of_failure f)) | exn -> return (`L ("loop: exception: " ^ Printexc.to_string exn)))) >>= function | `R (channels, addr) -> yap ~tag "-> connect" >>= fun () -> ( handle channels addr ; loop s ) diff --git a/lwt/examples/ex_common.ml b/lwt/examples/ex_common.ml index 51a92fff..a0353dd9 100644 --- a/lwt/examples/ex_common.ml +++ b/lwt/examples/ex_common.ml @@ -23,7 +23,7 @@ let print_alert where alert = let print_fail where fail = Printf.eprintf "(TLS FAIL (%s): %s)\n%!" - where (Fmt.to_to_string Tls.Engine.pp_failure fail) + where (Tls.Engine.string_of_failure fail) let null_auth ?ip:_ ~host:_ _ = Ok None diff --git a/lwt/examples/fuzz_server.ml b/lwt/examples/fuzz_server.ml index 0d64f94a..8f69e03e 100644 --- a/lwt/examples/fuzz_server.ml +++ b/lwt/examples/fuzz_server.ml @@ -45,7 +45,7 @@ let serve_ssl port callback = | Tls_lwt.Tls_alert a -> yap ~tag @@ "handler: " ^ Tls.Packet.alert_type_to_string a | Tls_lwt.Tls_failure a -> - yap ~tag @@ "handler: " ^ Fmt.to_to_string Tls.Engine.pp_failure a + yap ~tag @@ "handler: " ^ Tls.Engine.string_of_failure a | Unix.Unix_error (e, f, p) -> yap ~tag @@ "handler: " ^ (string_of_unix_err e f p) | _exn -> yap ~tag "handler: exception") @@ -59,7 +59,7 @@ let serve_ssl port callback = (function | Unix.Unix_error (e, f, p) -> return (`L (string_of_unix_err e f p)) | Tls_lwt.Tls_alert a -> return (`L (Tls.Packet.alert_type_to_string a)) - | Tls_lwt.Tls_failure f -> return (`L (Fmt.to_to_string Tls.Engine.pp_failure f)) + | Tls_lwt.Tls_failure f -> return (`L (Tls.Engine.string_of_failure f)) | exn -> let str = Printexc.to_string exn in return (`L ("loop: exception " ^ str)))) >>= function | `R (t, addr) -> let channels = Tls_lwt.of_t t in diff --git a/lwt/examples/resume_echo_server.ml b/lwt/examples/resume_echo_server.ml index 0684640c..b7a48ed5 100644 --- a/lwt/examples/resume_echo_server.ml +++ b/lwt/examples/resume_echo_server.ml @@ -74,7 +74,7 @@ let serve_ssl port callback = | Tls_lwt.Tls_alert a -> yap ~tag @@ "handler: " ^ Tls.Packet.alert_type_to_string a | Tls_lwt.Tls_failure a -> - yap ~tag @@ "handler: " ^ Fmt.to_to_string Tls.Engine.pp_failure a + yap ~tag @@ "handler: " ^ Tls.Engine.string_of_failure a | Unix.Unix_error (e, f, p) -> yap ~tag @@ "handler: " ^ (string_of_unix_err e f p) | _exn -> yap ~tag "handler: exception") @@ -96,7 +96,7 @@ let serve_ssl port callback = (function | Unix.Unix_error (e, f, p) -> return (`L (string_of_unix_err e f p)) | Tls_lwt.Tls_alert a -> return (`L (Tls.Packet.alert_type_to_string a)) - | Tls_lwt.Tls_failure f -> return (`L (Fmt.to_to_string Tls.Engine.pp_failure f)) + | Tls_lwt.Tls_failure f -> return (`L (Tls.Engine.string_of_failure f)) | exn -> let str = Printexc.to_string exn in return (`L ("loop: exception " ^ str)))) >>= function | `R t -> yap ~tag "-> connect" >>= fun () -> diff --git a/lwt/tls_lwt.ml b/lwt/tls_lwt.ml index d0b94a84..2740376d 100644 --- a/lwt/tls_lwt.ml +++ b/lwt/tls_lwt.ml @@ -283,5 +283,5 @@ let () = | Tls_alert typ -> Some ("TLS alert from peer: " ^ Tls.Packet.alert_type_to_string typ) | Tls_failure f -> - Some ("TLS failure: " ^ Fmt.to_to_string Tls.Engine.pp_failure f) + Some ("TLS failure: " ^ Tls.Engine.string_of_failure f) | _ -> None) diff --git a/tests/feedback.ml b/tests/feedback.ml index 383b3cd3..4b2cb074 100644 --- a/tests/feedback.ml +++ b/tests/feedback.ml @@ -22,7 +22,7 @@ module Flow = struct (rewrap_st (state, st'), ans, appdata) | Error (a, _) -> failwith @@ Printf.sprintf "[%s] %s error: %s" - tag descr (Fmt.to_to_string Tls.Engine.pp_failure a) + tag descr (Tls.Engine.string_of_failure a) | Ok _ -> failwith "decoded alert" end diff --git a/tests/key_derivation.ml b/tests/key_derivation.ml index 2875b0bd..a0a0e4c2 100644 --- a/tests/key_derivation.ml +++ b/tests/key_derivation.ml @@ -531,7 +531,7 @@ let self_signature () = (Mirage_crypto.Hash.digest hash log) cert with | Ok () -> () - | Error e -> Alcotest.fail ("self-verification failed " ^ Fmt.to_to_string Tls.Engine.pp_failure e) + | Error e -> Alcotest.fail ("self-verification failed " ^ Tls.Engine.string_of_failure e) let wire_signature () = (* let buf = Writer.assemble_handshake (CertificateVerify data) in @@ -542,7 +542,7 @@ let wire_signature () = (Mirage_crypto.Hash.digest hash log) cert with | Ok () -> () - | Error e -> Alcotest.fail ("trace-verification failed " ^ Fmt.to_to_string Tls.Engine.pp_failure e) + | Error e -> Alcotest.fail ("trace-verification failed " ^ Tls.Engine.string_of_failure e) let res_secret_00 = Cstruct.of_hex {| 4e cd 0e b6 ec 3b 4d 87 f5 d6 02 8f 92 2c a4 c5