remove ppx (cstruct and sexplib), removing sexplib converters

async/io.ml

@@ -3,10 +3,20 @@ open! Async
 include Io_intf
 
 module Tls_error = struct
+  module Alert = struct
+    type t = Tls.Packet.alert_type
+    let sexp_of_t a =
+      Sexplib.Sexp.Atom (Tls.Packet.alert_type_to_string a)
+  end
+  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)
+  end
   type t =
-    | Tls_alert of Tls.Packet.alert_type
+    | Tls_alert of Alert.t
     (** [Tls_alert] exception received from the other endpoint *)
-    | Tls_failure of Tls.Engine.failure
+    | Tls_failure of Fail.t
     (** [Tls_failure] exception while processing incoming data *)
     | Connection_closed
     | Connection_not_ready

eio/tests/tls_eio.md

@@ -19,11 +19,7 @@ let mypsk = ref None
 
 let ticket_cache = {
   Tls.Config.lookup = (fun _ -> None) ;
-  ticket_granted = (fun psk epoch ->
-      Logs.info (fun m -> m "ticket granted %a %a"
-                    Sexplib.Sexp.pp_hum (Tls.Core.sexp_of_psk13 psk)
-                    Sexplib.Sexp.pp_hum (Tls.Core.sexp_of_epoch_data epoch)) ;
-      mypsk := Some (psk, epoch)) ;
+  ticket_granted = (fun psk epoch -> mypsk := Some (psk, epoch)) ;
   lifetime = 0l ;
   timestamp = Ptime_clock.now
 }

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: " ^ Tls.Engine.string_of_failure f)
+        Some ("TLS failure: " ^ Fmt.to_to_string Tls.Engine.pp_failure f)
       | _ -> None)

lib/ciphersuite.ml

@@ -1,8 +1,16 @@
 (** Ciphersuite definitions and some helper functions. *)
 
 (** sum type of all possible key exchange methods *)
-type key_exchange_algorithm_dhe = [ `FFDHE | `ECDHE ] [@@deriving sexp_of]
-type key_exchange_algorithm = [ key_exchange_algorithm_dhe | `RSA ] [@@deriving sexp_of]
+type key_exchange_algorithm_dhe = [ `FFDHE | `ECDHE ]
+type key_exchange_algorithm = [ key_exchange_algorithm_dhe | `RSA ]
+
+let pp_key_exchange_algorithm_dhe ppf = function
+  | `FFDHE -> Fmt.string ppf "FFDHE"
+  | `ECDHE -> Fmt.string ppf "ECDHE"
+
+let pp_key_exchange_algorithm ppf = function
+  | #key_exchange_algorithm_dhe as d -> pp_key_exchange_algorithm_dhe ppf d
+  | `RSA -> Fmt.string ppf "RSA"
 
 (** [required_usage kex] is [usage] which a certificate must have if it is used in the given [kex] method *)
 let required_usage = function
@@ -13,32 +21,47 @@ type block_cipher =
   | TRIPLE_DES_EDE_CBC
   | AES_128_CBC
   | AES_256_CBC
-  [@@deriving sexp_of]
+
+let pp_block_cipher ppf = function
+  | TRIPLE_DES_EDE_CBC -> Fmt.string ppf "3DES EDE CBC"
+  | AES_128_CBC -> Fmt.string ppf "AES128 CBC"
+  | AES_256_CBC -> Fmt.string ppf "AES256 CBC"
 
 type aead_cipher =
   | AES_128_CCM
   | AES_256_CCM
   | AES_128_GCM
   | AES_256_GCM
   | CHACHA20_POLY1305
-  [@@deriving sexp_of]
 
-module H = struct
-  type t = Mirage_crypto.Hash.hash
+let pp_aead_cipher ppf = function
+  | AES_128_CCM -> Fmt.string ppf "AES128 CCM"
+  | AES_256_CCM -> Fmt.string ppf "AES256 CCM"
+  | AES_128_GCM -> Fmt.string ppf "AES128 GCM"
+  | AES_256_GCM -> Fmt.string ppf "AES256 GCM"
+  | CHACHA20_POLY1305 -> Fmt.string ppf "CHACHA20 POLY1305"
 
-  let hs =
-    [ (`MD5, "md5") ; (`SHA1, "sha1") ; (`SHA224, "sha224") ;
-      (`SHA256, "sha256") ; (`SHA384, "sha384") ; (`SHA512, "sha512") ]
+type payload_protection13 = [ `AEAD of aead_cipher ]
 
-  let sexp_of_t h = Sexplib.Sexp.Atom (List.assoc h hs)
-end
-
-type payload_protection13 = [ `AEAD of aead_cipher ] [@@deriving sexp_of]
+let pp_payload_protection13 ppf = function
+  | `AEAD a -> Fmt.pf ppf "AEAD %a" pp_aead_cipher a
 
 type payload_protection =  [
   payload_protection13
-  | `Block of block_cipher * H.t
-  ] [@@deriving sexp_of]
+  | `Block of block_cipher * Mirage_crypto.Hash.hash
+  ]
+
+let pp_hash ppf = function
+  | `MD5 -> Fmt.string ppf "MD5"
+  | `SHA1 -> Fmt.string ppf "SHA1"
+  | `SHA224 -> Fmt.string ppf "SHA224"
+  | `SHA256 -> Fmt.string ppf "SHA256"
+  | `SHA384 -> Fmt.string ppf "SHA384"
+  | `SHA512 -> Fmt.string ppf "SHA512"
+
+let pp_payload_protection ppf = function
+  | #payload_protection13 as p -> pp_payload_protection13 ppf p
+  | `Block (b, h) -> Fmt.pf ppf "BLOCK %a %a" pp_block_cipher b pp_hash h
 
 (* this is K_LEN, max 8 N_MIN from RFC5116 sections 5.1 & 5.2 -- as defined in TLS1.3 RFC 8446 Section 5.3 *)
 let kn_13 = function
@@ -74,7 +97,7 @@ type ciphersuite13 = [
   | `AES_256_GCM_SHA384
   | `CHACHA20_POLY1305_SHA256
   | `AES_128_CCM_SHA256
-] [@@deriving sexp_of]
+]
 
 let privprot13 = function
   | `AES_128_GCM_SHA256 -> AES_128_GCM
@@ -132,7 +155,7 @@ type ciphersuite = [
   | `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256
   | `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384
   | `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256
-]  [@@deriving sexp_of]
+  ]
 
 let ciphersuite_to_ciphersuite13 : ciphersuite -> ciphersuite13 option = function
   | #ciphersuite13 as cs -> Some cs
@@ -217,8 +240,6 @@ let ciphersuite_to_any_ciphersuite = function
   | `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 -> Packet.TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384
   | `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 -> Packet.TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256
 
-let ciphersuite_to_string x = Packet.any_ciphersuite_to_string (ciphersuite_to_any_ciphersuite x)
-
 (** [get_kex_privprot ciphersuite] is [(kex, privacy_protection)] where it dissects the [ciphersuite] into a pair containing the key exchange method [kex], and its [privacy_protection] *)
 let get_keytype_kex_privprot = function
   | `RSA_WITH_3DES_EDE_CBC_SHA       -> (`RSA, `RSA, `Block (TRIPLE_DES_EDE_CBC, `SHA1))
@@ -272,6 +293,22 @@ let ciphersuite_keytype c =
   let keytype, _kex, _pp = get_keytype_kex_privprot c in
   keytype
 
+let pp_ciphersuite ppf cs =
+  let keytype, kex, pp = get_keytype_kex_privprot cs in
+  let pp_keytype ppf = function
+    | `EC -> Fmt.string ppf "ECDSA"
+    | `RSA -> Fmt.string ppf "RSA"
+  in
+  match cs with
+  | #ciphersuite13 -> Fmt.pf ppf "%a" pp_payload_protection pp
+  | _ -> Fmt.pf ppf "%a %a %a" pp_key_exchange_algorithm kex pp_keytype keytype
+           pp_payload_protection pp
+
+let pp_any_ciphersuite ppf cs =
+  match any_ciphersuite_to_ciphersuite cs with
+  | Some cs -> pp_ciphersuite ppf cs
+  | None -> Fmt.pf ppf "ciphersuite %04X" (Packet.any_ciphersuite_to_int cs)
+
 let ciphersuite_fs cs =
   match ciphersuite_kex cs with
   | #key_exchange_algorithm_dhe -> true

lib/config.ml

@@ -1,31 +1,39 @@
 open Core
 
-open Sexplib.Std
-
 let src = Logs.Src.create "tls.config" ~doc:"TLS config"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-type certchain = Cert.t list * Priv.t [@@deriving sexp_of]
+type certchain = X509.Certificate.t list * X509.Private_key.t
 
 type own_cert = [
   | `None
   | `Single of certchain
   | `Multiple of certchain list
   | `Multiple_default of certchain * certchain list
-] [@@deriving sexp_of]
+]
+
+let pp_cert ppf cs =
+  let from, until = X509.Certificate.validity cs in
+  Fmt.pf ppf "subject %a@ issuer %a@ valid from %a until %a"
+    X509.Distinguished_name.pp (X509.Certificate.subject cs)
+    X509.Distinguished_name.pp (X509.Certificate.issuer cs)
+    (Ptime.pp_human ~tz_offset_s:0 ()) from
+    (Ptime.pp_human ~tz_offset_s:0 ()) until
+
+let pp_certchain ppf (chain, _) =
+  Fmt.(list ~sep:(any "@.") pp_cert) ppf chain
+
+let pp_own_cert ppf = function
+  | `None -> Fmt.string ppf "NONE"
+  | `Single chain -> pp_certchain ppf chain
+  | `Multiple cs ->
+    Fmt.pf ppf "multiple: %a" Fmt.(list ~sep:(any "@.@.") pp_certchain) cs
+  | `Multiple_default (c, cs) ->
+    Fmt.pf ppf "multiple default:@.%[email protected]:@.%a"
+      pp_certchain c
+      Fmt.(list ~sep:(any "@.@.") pp_certchain) cs
 
 type session_cache = SessionID.t -> epoch_data option
-let sexp_of_session_cache _ = Sexplib.Sexp.Atom "SESSION_CACHE"
-
-module Auth = struct
-  type t = X509.Authenticator.t
-  let sexp_of_t _ = Sexplib.Sexp.Atom "Authenticator"
-end
-
-module DN = struct
-  type t = X509.Distinguished_name.t
-  let sexp_of_t _ = Sexplib.Sexp.Atom "distinguished name"
-end
 
 type ticket_cache = {
   lookup : Cstruct.t -> (psk13 * epoch_data) option ;
@@ -34,28 +42,50 @@ type ticket_cache = {
   timestamp : unit -> Ptime.t
 }
 
-type ticket_cache_opt = ticket_cache option
-let sexp_of_ticket_cache_opt _ = Sexplib.Sexp.Atom "TICKET_CACHE"
-
 (* TODO: min_rsa, min_dh *)
 type config = {
   ciphers : Ciphersuite.ciphersuite list ;
   protocol_versions : tls_version * tls_version ;
   signature_algorithms : signature_algorithm list ;
   use_reneg : bool ;
-  authenticator : Auth.t option ;
-  peer_name : Peer_name.t option ;
+  authenticator : X509.Authenticator.t option ;
+  peer_name : [`host] Domain_name.t option ;
   own_certificates : own_cert ;
-  acceptable_cas : DN.t list ;
+  acceptable_cas : X509.Distinguished_name.t list ;
   session_cache : session_cache ;
-  ticket_cache : ticket_cache_opt ;
+  ticket_cache : ticket_cache option ;
   cached_session : epoch_data option ;
   cached_ticket : (psk13 * epoch_data) option ;
   alpn_protocols : string list ;
   groups : group list ;
   zero_rtt : int32 ;
-  ip : Ipaddr_sexp.t option ;
-} [@@deriving sexp_of]
+  ip : Ipaddr.t option ;
+}
+
+let pp_config ppf cfg =
+  Fmt.pf ppf
+    "ciphers: %a@. \
+     minimal protocol version: %a@. \
+     maximum protocol version: %a@. \
+     signature algorithms: %a@. \
+     renegotiation enabled %B@. \
+     peer name: %a@. \
+     own certificate: %a@. \
+     acceptable CAs: %a@. \
+     alpn protocols: %a@. \
+     groups: %a@. \
+     IP: %a@."
+    Fmt.(list ~sep:(any ", ") Ciphersuite.pp_ciphersuite) cfg.ciphers
+    pp_tls_version (fst cfg.protocol_versions)
+    pp_tls_version (snd cfg.protocol_versions)
+    Fmt.(list ~sep:(any ", ") pp_signature_algorithm) cfg.signature_algorithms
+    cfg.use_reneg
+    Fmt.(option ~none:(any "none provided") Domain_name.pp) cfg.peer_name
+    pp_own_cert cfg.own_certificates
+    Fmt.(list ~sep:(any ", ") X509.Distinguished_name.pp) cfg.acceptable_cas
+    Fmt.(list ~sep:(any ", ") string) cfg.alpn_protocols
+    Fmt.(list ~sep:(any ", ") pp_group) cfg.groups
+    Fmt.(option ~none:(any "none provided") Ipaddr.pp) cfg.ip
 
 let ciphers13 cfg =
   List.rev
@@ -510,11 +540,8 @@ let validate_keys_sig_algs config =
     then
       invalid "certificate provided which does not allow any signature algorithm"
 
-type client = config [@@deriving sexp_of]
-type server = config [@@deriving sexp_of]
-
-let client_of_sexp _ = invalid_arg "couldn't decode client configuration"
-let server_of_sexp _ = invalid_arg "couldn't decode server configuration"
+type client = config
+type server = config
 
 let of_server conf = conf
 and of_client conf = conf
@@ -551,8 +578,7 @@ let client
     } in
   let config = validate_common config in
   validate_client config ;
-  Log.debug (fun m -> m "client with %s"
-                (Sexplib.Sexp.to_string_hum (sexp_of_config config)));
+  Log.debug (fun m -> m "client with %a" pp_config config);
   config
 
 let server
@@ -578,6 +604,5 @@ let server
   let config = validate_server config in
   let config = validate_common config in
   validate_keys_sig_algs config;
-  Log.debug (fun m -> m "server with %s"
-                (Sexplib.Sexp.to_string_hum (sexp_of_config config)));
+  Log.debug (fun m -> m "server with %a" pp_config config);
   config

lib/config.mli

@@ -5,7 +5,7 @@ open Core
 (** {1 Config type} *)
 
 (** certificate chain and private key of the first certificate *)
-type certchain = Cert.t list * X509.Private_key.t
+type certchain = X509.Certificate.t list * X509.Private_key.t
 
 (** polymorphic variant of own certificates *)
 type own_cert = [
@@ -24,8 +24,6 @@ type ticket_cache = {
   timestamp : unit -> Ptime.t
 }
 
-type ticket_cache_opt = ticket_cache option
-
 (** configuration parameters *)
 type config = private {
   ciphers : Ciphersuite.ciphersuite list ; (** ordered list (regarding preference) of supported cipher suites *)
@@ -37,23 +35,23 @@ type config = private {
   own_certificates : own_cert ; (** optional default certificate chain and other certificate chains *)
   acceptable_cas : X509.Distinguished_name.t list ; (** ordered list of acceptable certificate authorities *)
   session_cache : session_cache ;
-  ticket_cache : ticket_cache_opt ;
+  ticket_cache : ticket_cache option ;
   cached_session : epoch_data option ;
   cached_ticket : (psk13 * epoch_data) option ;
   alpn_protocols : string list ; (** optional ordered list of accepted alpn_protocols *)
   groups : group list ; (** the first FFDHE will be used for TLS 1.2 and below if a DHE ciphersuite is used *)
   zero_rtt : int32 ;
   ip : Ipaddr.t option ;
-} [@@deriving sexp_of]
+}
 
 (** [ciphers13 config] are the ciphersuites for TLS 1.3 in the configuration. *)
 val ciphers13 : config -> Ciphersuite.ciphersuite13 list
 
 (** opaque type of a client configuration *)
-type client [@@deriving sexp]
+type client
 
 (** opaque type of a server configuration *)
-type server [@@deriving sexp]
+type server
 
 (** {1 Constructors} *)