From 80635f4bf2d1b836857f5fe4a58209ea1ed223de Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Mon, 20 Nov 2023 12:01:20 +0100
Subject: [PATCH] Engine.epoch: return a result instead of a custom polymorphic
 variant

add CHANGES
---
 CHANGES.md           | 11 +++++++++++
 async/io.ml          |  7 +++----
 eio/tls_eio.ml       |  7 ++-----
 lib/engine.ml        |  9 +--------
 lib/engine.mli       | 13 ++-----------
 lwt/tls_lwt.ml       |  7 ++-----
 mirage/tls_mirage.ml |  5 +----
 7 files changed, 22 insertions(+), 37 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 477834ca..9c4650de 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,14 @@
+## v0.17.3 (2023-11-20)
+
+* tls: provide Engine.export_key_material, which implements RFC 5705 (and 8446)
+  TLS EKM (#482 @hannesm)
+* tls: fix protocol_version in Engine.epoch (TLS 1.3 always pretended TLS 1.0)
+  (#482 @hannesm)
+* tls: add the side (`` `Client `` or `` `Server ``) to epoch_data
+  (#482 @hannesm)
+* BREAKING tls: Engine.epoch - return result instead of custom variant
+  (#483 @hannesm)
+
 ## v0.17.2 (2023-09-24)
 
 * tls-eio: update to eio 0.12 (#479 @talex5)
diff --git a/async/io.ml b/async/io.ml
index a639c27a..25cf99b5 100644
--- a/async/io.ml
+++ b/async/io.ml
@@ -193,10 +193,9 @@ module Make (Fd : Fd) : S with module Fd := Fd = struct
 
   let epoch t =
     match t.state with
-    | Active tls ->
-      (match Tls.Engine.epoch tls with
-       | `InitialEpoch -> assert false (* can never occur! *)
-       | `Epoch data -> Ok data)
+    | Active tls -> (match Tls.Engine.epoch tls with
+       | Ok _ as o -> o
+       | Error () -> Or_error.error_string "no TLS state available yet")
     | Eof -> Or_error.error_string "TLS state is end of file"
     | Error _ -> Or_error.error_string "TLS state is error"
   ;;
diff --git a/eio/tls_eio.ml b/eio/tls_eio.ml
index cdcae9e0..5eec39f5 100644
--- a/eio/tls_eio.ml
+++ b/eio/tls_eio.ml
@@ -199,11 +199,8 @@ module Raw = struct
 
   let epoch t =
     match t.state with
-    | `Active tls -> ( match Tls.Engine.epoch tls with
-        | `InitialEpoch -> assert false (* can never occur! *)
-        | `Epoch data   -> Ok data )
-    | `Eof      -> Error ()
-    | `Error _  -> Error ()
+    | `Active tls -> Tls.Engine.epoch tls
+    | `Eof | `Error _ -> Error ()
 
   let copy t ~src = Eio.Flow.Pi.simple_copy ~single_write t ~src
 
diff --git a/lib/engine.ml b/lib/engine.ml
index 0b173f97..4db71b90 100644
--- a/lib/engine.ml
+++ b/lib/engine.ml
@@ -735,15 +735,8 @@ let client config =
 
 let server config = new_state Config.(of_server config) `Server
 
-type epoch = [
-  | `InitialEpoch
-  | `Epoch of epoch_data
-]
-
 let epoch state =
-  match epoch_of_hs state.handshake with
-  | None -> `InitialEpoch
-  | Some e -> `Epoch e
+  Option.to_result ~none:() (epoch_of_hs state.handshake)
 
 let export_key_material (e : epoch_data) ?context label length =
   match e.protocol_version with
diff --git a/lib/engine.mli b/lib/engine.mli
index 4777c5a5..9b75c7b9 100644
--- a/lib/engine.mli
+++ b/lib/engine.mli
@@ -188,18 +188,9 @@ val key_update : ?request:bool -> state -> (state * Cstruct.t, failure) result
 
 (** {1 Session information} *)
 
-(** polymorphic variant of session information.  The first variant
-    [`InitialEpoch] will only be used for TLS states without completed
-    handshake.  The second variant, [`Epoch], contains actual session
-    data. *)
-type epoch = [
-  | `InitialEpoch
-  | `Epoch of Core.epoch_data
-]
-
 (** [epoch state] is [epoch], which contains the session
-    information. *)
-val epoch : state -> epoch
+    information. If there's no established session yet, an error is returned. *)
+val epoch : state -> (Core.epoch_data, unit) result
 
 (** [export_key_material epoch_data ?context label length] is the RFC 5705
     exported key material of [length] bytes using [label] and, if provided,
diff --git a/lwt/tls_lwt.ml b/lwt/tls_lwt.ml
index 2740376d..a1fde8a8 100644
--- a/lwt/tls_lwt.ml
+++ b/lwt/tls_lwt.ml
@@ -237,11 +237,8 @@ module Unix = struct
 
   let epoch t =
     match t.state with
-    | `Active tls -> ( match Tls.Engine.epoch tls with
-        | `InitialEpoch -> assert false (* can never occur! *)
-        | `Epoch data   -> Ok data )
-    | `Eof      -> Error ()
-    | `Error _  -> Error ()
+    | `Active tls -> Tls.Engine.epoch tls
+    | `Eof | `Error _ -> Error ()
 end
 
 
diff --git a/mirage/tls_mirage.ml b/mirage/tls_mirage.ml
index f1beacc5..e6ed1a5d 100644
--- a/mirage/tls_mirage.ml
+++ b/mirage/tls_mirage.ml
@@ -193,10 +193,7 @@ module Make (F : Mirage_flow.S) = struct
   let epoch flow =
     match flow.state with
     | `Eof | `Error _ -> Error ()
-    | `Active tls     ->
-        match Tls.Engine.epoch tls with
-        | `InitialEpoch -> assert false (* `drain_handshake` invariant. *)
-        | `Epoch e      -> Ok e
+    | `Active tls     -> Tls.Engine.epoch tls
 
 (*   let create_connection t tls_params host (addr, port) =
     |+ XXX addr -> (host : string) +|