change release to 0.17.0, re-add Engine.string_of_failure

mirleft · Mar 1, 2023 · 7c3fda0 · 7c3fda0
1 parent 30f0a86
commit 7c3fda0
Show file tree

Hide file tree

Showing 12 changed files with 19 additions and 14 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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