diff --git a/Benchmarks/Benchmarks.hs b/Benchmarks/Benchmarks.hs
--- a/Benchmarks/Benchmarks.hs
+++ b/Benchmarks/Benchmarks.hs
@@ -1,64 +1,187 @@
 {-# LANGUAGE BangPatterns #-}
+
 module Main where
 
-import Connection
 import Certificate
-import PubKey
-import Criterion.Main
 import Control.Concurrent.Chan
-import Network.TLS
+import Data.Default (def)
+import Data.IORef
 import Data.X509
 import Data.X509.Validation
-import Data.Default.Class
+import Test.Tasty.Bench
+import Network.TLS
+import Network.TLS.Extra.Cipher
+import Session
+import Run
+import PubKey
 
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 
-recvDataNonNull ctx = recvData ctx >>= \l -> if B.null l then recvDataNonNull ctx else return l
+blockCipher :: Cipher
+blockCipher =
+    Cipher
+        { cipherID = 0xff12
+        , cipherName = "rsa-id-const"
+        , cipherBulk =
+            Bulk
+                { bulkName = "id"
+                , bulkKeySize = 16
+                , bulkIVSize = 16
+                , bulkExplicitIV = 0
+                , bulkAuthTagLen = 0
+                , bulkBlockSize = 16
+                , bulkF = BulkBlockF $ \_ _ _ m -> (m, B.empty)
+                }
+        , cipherHash = MD5
+        , cipherPRFHash = Nothing
+        , cipherKeyExchange = CipherKeyExchange_RSA
+        , cipherMinVer = Nothing
+        }
 
+getParams :: Version -> Cipher -> (ClientParams, ServerParams)
 getParams connectVer cipher = (cParams, sParams)
-  where sParams = def { serverSupported = supported
-                      , serverShared = def {
-                          sharedCredentials = Credentials [ (CertificateChain [simpleX509 $ PubKeyRSA pubKey], PrivKeyRSA privKey) ]
-                          }
-                      }
-        cParams = (defaultParamsClient "" B.empty)
+  where
+    sParams =
+        def
+            { serverSupported = supported
+            , serverShared =
+                def
+                    { sharedCredentials =
+                        Credentials
+                            [(CertificateChain [simpleX509 $ PubKeyRSA pubKey], PrivKeyRSA privKey)]
+                    }
+            }
+    cParams =
+        (defaultParamsClient "" B.empty)
             { clientSupported = supported
-            , clientShared = def { sharedValidationCache = ValidationCache
-                                        { cacheAdd = \_ _ _ -> return ()
-                                        , cacheQuery = \_ _ _ -> return ValidationCachePass
-                                        }
-                                 }
+            , clientShared =
+                def
+                    { sharedValidationCache =
+                        ValidationCache
+                            { cacheAdd = \_ _ _ -> return ()
+                            , cacheQuery = \_ _ _ -> return ValidationCachePass
+                            }
+                    }
             }
-        supported = def { supportedCiphers = [cipher]
-                        , supportedVersions = [connectVer]
-                        }
-        (pubKey, privKey) = getGlobalRSAPair
+    supported =
+        def
+            { supportedCiphers = [cipher]
+            , supportedVersions = [connectVer]
+            , supportedGroups = [X25519, FFDHE2048]
+            }
+    (pubKey, privKey) = getGlobalRSAPair
 
-runTLSPipe params tlsServer tlsClient d name = bench name $ do
-    (startQueue, resultQueue) <- establishDataPipe params tlsServer tlsClient
-    writeChan startQueue d
-    readChan resultQueue
+runTLSPipe
+    :: (ClientParams, ServerParams)
+    -> (Context -> Chan b -> IO ())
+    -> (Chan a -> Context -> IO ())
+    -> a
+    -> IO b
+runTLSPipe params tlsServer tlsClient d = do
+    withDataPipe params tlsServer tlsClient $ \(writeStart, readResult) -> do
+        writeStart d
+        readResult
 
-bench1 params !d name = runTLSPipe params tlsServer tlsClient d name
-  where tlsServer ctx queue = do
-            handshake ctx
-            d <- recvDataNonNull ctx
-            writeChan queue d
-            return ()
-        tlsClient queue ctx = do
-            handshake ctx
-            d <- readChan queue
-            sendData ctx (L.fromChunks [d])
-            bye ctx
-            return ()
+runTLSPipeSimple
+    :: (ClientParams, ServerParams) -> B.ByteString -> IO B.ByteString
+runTLSPipeSimple params = runTLSPipe params tlsServer tlsClient
+  where
+    tlsServer ctx queue = do
+        handshake ctx
+        d <- recvData ctx
+        writeChan queue d
+        bye ctx
+    tlsClient queue ctx = do
+        handshake ctx
+        d <- readChan queue
+        sendData ctx (L.fromChunks [d])
+        byeBye ctx
 
-main = defaultMain
-    [ bgroup "connection"
-        -- not sure the number actually make sense for anything. improve ..
-        [ bench1 (getParams SSL3 blockCipher) (B.replicate 256 0) "SSL3-256 bytes"
-        , bench1 (getParams TLS10 blockCipher) (B.replicate 256 0) "TLS10-256 bytes"
-        , bench1 (getParams TLS11 blockCipher) (B.replicate 256 0) "TLS11-256 bytes"
-        , bench1 (getParams TLS12 blockCipher) (B.replicate 256 0) "TLS12-256 bytes"
+benchConnection
+    :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark
+benchConnection params !d name = bench name . nfIO $ runTLSPipeSimple params d
+
+benchResumption
+    :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark
+benchResumption params !d name = env initializeSession runResumption
+  where
+    initializeSession = do
+        sessionRefs <- twoSessionRefs
+        let sessionManagers = twoSessionManagers sessionRefs
+            params1 = setPairParamsSessionManagers sessionManagers params
+        _ <- runTLSPipeSimple params1 d
+
+        Just sessionParams <- readClientSessionRef sessionRefs
+        let params2 = setPairParamsSessionResuming sessionParams params1
+        newIORef params2
+
+    runResumption paramsRef = bench name . nfIO $ do
+        params2 <- readIORef paramsRef
+        runTLSPipeSimple params2 d
+
+benchResumption13
+    :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark
+benchResumption13 params !d name = env initializeSession runResumption
+  where
+    initializeSession = do
+        sessionRefs <- twoSessionRefs
+        let sessionManagers = twoSessionManagers sessionRefs
+            params1 = setPairParamsSessionManagers sessionManagers params
+        _ <- runTLSPipeSimple params1 d
+        newIORef (params1, sessionRefs)
+
+    -- with TLS13 the sessionId is constantly changing so we must update
+    -- our parameters at each iteration unfortunately
+    runResumption paramsRef = bench name . nfIO $ do
+        (params1, sessionRefs) <- readIORef paramsRef
+        Just sessionParams <- readClientSessionRef sessionRefs
+        let params2 = setPairParamsSessionResuming sessionParams params1
+        runTLSPipeSimple params2 d
+
+benchCiphers :: String -> Version -> B.ByteString -> [Cipher] -> Benchmark
+benchCiphers name connectVer d = bgroup name . map doBench
+  where
+    doBench cipher =
+        benchResumption13 (getParams connectVer cipher) d (cipherName cipher)
+
+main :: IO ()
+main =
+    defaultMain
+        [ bgroup
+            "connection"
+            -- not sure the number actually make sense for anything. improve ..
+            [ benchConnection (getParams TLS12 blockCipher) small "TLS12-256 bytes"
+            ]
+        , bgroup
+            "resumption"
+            [ benchResumption (getParams TLS12 blockCipher) small "TLS12-256 bytes"
+            ]
+        , -- Here we try to measure TLS12 and TLS13 performance with AEAD ciphers.
+          -- Resumption and a larger message can be a demonstration of the symmetric
+          -- crypto but for TLS13 this does not work so well because of dhe_psk.
+          benchCiphers
+            "TLS12"
+            TLS12
+            large
+            [ cipher_DHE_RSA_WITH_AES_128_GCM_SHA256
+            , cipher_DHE_RSA_WITH_AES_256_GCM_SHA384
+            , cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+            , cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256
+            , cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384
+            , cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+            ]
+        , benchCiphers
+            "TLS13"
+            TLS13
+            large
+            [ cipher13_AES_128_GCM_SHA256
+            , cipher13_AES_256_GCM_SHA384
+            , cipher13_CHACHA20_POLY1305_SHA256
+            , cipher13_AES_128_CCM_SHA256
+            , cipher13_AES_128_CCM_8_SHA256
+            ]
         ]
-    ]
+  where
+    small = B.replicate 256 0
+    large = B.replicate 102400 0
diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,572 @@
+# Change log for "tls"
+
+## Version 2.4.3
+
+* A server checks clientAuth of ExtendedKeyUsage in a client
+  certificate on client authentication.
+
+## Version 2.4.2
+
+* The `Network.TLS.Extra.CipherCBC` module is added.
+  [#526](https://github.com/haskell-tls/hs-tls/pull/526)
+
+## Version 2.4.1
+
+* Ensure same `supported_groups` before/after HRR.
+* New `clientWantTicket` parameter makes it possible to opt-out of soliciting
+  session tickets from servers.
+
+## Version 2.4.0
+
+* Identical to v2.3.1 but major version up as v2.3.1 breaks "quic".
+
+## Version 2.3.1 (deprecated)
+
+* Using ScrubbedBytes for secrets.
+* Key echange with ML-KEM.
+  [#517](https://github.com/haskell-tls/hs-tls/pull/517)
+* Expose get certificate chain function
+  [#520](https://github.com/haskell-tls/hs-tls/pull/520)
+
+## Version 2.3.0
+
+* Using "ram" instead of "memory".
+
+## Version 2.2.2
+
+* A new architecture to calculate receiver's transcript hash with wire
+  format.
+  [#515](https://github.com/haskell-tls/hs-tls/pull/515)
+* Enabling compressed certificate on the client side again.
+
+## Version 2.2.1
+
+* Disabling compressed certificate on the client side.
+  [#514](https://github.com/haskell-tls/hs-tls/issues/514)
+
+## Version 2.2.0
+
+* Using crypton-asn1-* and time-hourglass.
+  [#512](https://github.com/haskell-tls/hs-tls/pull/512)
+* Major version up due to re-exports.
+
+## Version 2.1.14
+
+* Supporting P384 and P521 curves.
+  [#511](https://github.com/haskell-tls/hs-tls/pull/511)
+* Fixing some bugs of `tls-client`.
+
+## Version 2.1.13
+
+* Don't contain early_data if serverEarlyDataSize is 0.
+  [#510](https://github.com/haskell-tls/hs-tls/pull/510)
+
+## Version 2.1.12
+
+* Restore benchmarks.
+  [#509](https://github.com/haskell-tls/hs-tls/pull/509)
+* Supporting random 1.2.
+  [#508](https://github.com/haskell-tls/hs-tls/pull/508)
+* Add --trusted-anchor cli option to tls-client.
+  [#505](https://github.com/haskell-tls/hs-tls/pull/505)
+
+## Version 2.1.11
+
+* Removing OVERLAPS instances.
+
+## Version 2.1.10
+
+* Supporting the SSLKEYLOGFILE environment variable.
+  [#499](https://github.com/haskell-tls/hs-tls/pull/499)
+
+## Version 2.1.9
+
+* Providing ECH(Encrypted Client Hello). See `sharedECHConfigList`,
+  `clientUseECH` and `serverECHKey`. Note that the `ech-gen` command,
+  `loadECHConfigList` and `loadECHSecretKeys` are provided by the
+  `ech-config` package.
+
+## Version 2.1.8
+
+* Moving `Limit` to `Shared` to maintain backward compatibility
+  of `TLSParams` class.
+* Deprecating 2.1.7.
+
+## Version 2.1.7
+
+* Introducing `Limit` parameter.
+* Implementing "Record Size Limit Extension for TLS" (RFC8449).
+  Set `limitRecordSize` use it.
+* Implementing "TLS Certificate Compression" (RFC 8879).
+  This feature is automatically used if the peer supports it.
+* More tests with `tlsfuzzer` especially for client authentication
+  and 0-RTT.
+* Implementing a utility function, `validateClientCertificate`, for
+  client authentication.
+* Bug fix for echo back logic of Cookie extension.
+* More pretty show for the internal `Handshake` structure for debugging.
+
+## Version 2.1.6
+
+* Testing with "tlsfuzzer" again. Now don't send an alert against to
+  peer's alert. Double locking (aka self dead-lock) is fixed. Sending
+  an alert for known-but-cannot-parse extensions. Other corner cases
+  are also fixed.
+* `tls-client -d` and `tls-server -d` pretty-prints `Handshake`.
+
+## Version 2.1.5
+
+* Removing the dependency on the async package.
+* Restore a few DHE_RSA ciphers.
+  [#493](https://github.com/haskell-tls/hs-tls/pull/493)
+
+## Version 2.1.4
+
+* Exporting defaultValidationCache.
+
+## Version 2.1.3
+
+* Remove `data-default` version constraint.
+  [#492](https://github.com/haskell-tls/hs-tls/pull/492)
+* Exporting default variables.
+  [#448](https://github.com/haskell-tls/hs-tls/pull/488)
+
+## Version 2.1.2
+
+* Using data-default instead of data-default-class.
+
+## Version 2.1.1
+
+* `bye` directly calls `timeout recvHS13`, not spawning a thread for
+  `timeout recvHS13`. So, `bye` can receive an exception if thrown.
+
+## Version 2.1.0
+
+* Breaking change: stop exporting constructors to maintain future
+  compatibilities. Field names are still exported, and values can be updated
+  with them using record syntax. Use `def` and `noSessionManager` as initial
+  values.
+* `onServerFinished` is added to `ClientHooks`.
+* `clientWantSessionResumeList` is added to `ClientParams` to support
+  multiple tickets for TLS 1.3.
+
+## Version 2.0.6
+
+* Setting `supportedCiphers` in `defaultSupported` to `ciphersuite_default`.
+  So, users don't have to override this value anymore by exporting
+  `Network.TLS.Extra.Cipher`.
+  [#471](https://github.com/haskell-tls/hs-tls/pull/471)
+* `ciphersuite_default` is the same as `ciphersuite_strong`.
+  So, the duplicated definition is removed.
+* Add missing modules for util/tls-client and util/tls-server.
+
+## Version 2.0.5
+
+* Fixing handshake13_0rtt_fallback
+* Client checks if the group of PSK is contained in Supported_Groups.
+* HRR is not allowed for 0-RTT.
+
+## Version 2.0.4
+
+* More fix for 0-RTT when application data is available while receiving CF.
+* New util/tls-client and util/tls-server.
+
+## Version 2.0.3
+
+* Fixing a bug where `timeout` in `bye` does not work.
+* util/client -> util/tls-client
+* util/server -> util/tls-server
+
+## Version 2.0.2
+
+* Client checks sessionMaxEarlyDataSize to decide 0-RTT
+* Client checks the resumption cipher properly.
+
+## Version 2.0.1
+
+* Fix a leak of pending data to be sent.
+
+## Version 2.0.0
+
+* `tls` now only supports TLS 1.2 and TLS 1.3 with safe cipher suites.
+* Security: BREAKING CHANGE: TLS 1.0 and TLS 1.1 are removed.
+* Security: BREAKING CHANGE: all CBC cipher suite are removed.
+* Security: BREAKING CHANGE: RC4 and 3DES are removed.
+* Security: BREAKING CHANGE: DSS(digital signature standard) is removed.
+* Security: BREAKING CHANGE: TLS 1.2 servers require
+  EMS(extended main secret) by default.
+  `supportedExtendedMasterSec` is renamed to
+  `supportedExtendedMainSecret`.
+* BREAKING CHANGE: the package is now complied with `Strict` and `StrictData`.
+* BREAKING CHANGE: Many data structures are re-defined with
+ `PatternSynonyms` for extensibility.
+* BREAKING CHANGE: the structure of `SessionManager` is changed
+  to support session tickets.
+* API: BREAKING CHANGE: `sendData` can send early data (0-RTT).
+  `clientEarlyData` is removed.
+  To send early data via `sendData`, set `clientUseEarlyData` to `True`.
+  [#466](https://github.com/haskell-tls/hs-tls/issues/466)
+* API: `handshake` can receive an alert of client authentication failure
+  for TLS 1.3.
+  [#463](https://github.com/haskell-tls/hs-tls/pull/463)
+* API: `bye` can receive NewSessionTicket for TLS 1.3.
+* Channel binding: `getFinished` and `getPeerFinished` are deprecated.
+  Use `getTLSUnique` instead.
+  [#462](https://github.com/haskell-tls/hs-tls/pull/462)
+* Channel binding: `getTLSExporter` and `getTLSServerEndPoint` are provided.
+  [#462](https://github.com/haskell-tls/hs-tls/pull/462)
+* Refactoring: the monolithic `handshake` is divided to follow
+  the diagram of TLS 1.2 and 1.3 for readability.
+* Refactoring: test cases are refactored for maintenability
+  and readablity. `hspec` is used instead of `tasty`.
+* Code format: `fourmolu` is used as an official formatter.
+* Catching up RFC8446bis-09.
+  [#467](https://github.com/haskell-tls/hs-tls/issues/467)
+
+## Version 1.9.0
+
+* BREAKING CHANGE: The type of the `Error_Protocol` constructor of `TLSError` has changed.
+  The "warning" case has been split off into a new `Error_Protocol_Warning` constructor.
+  [#460](https://github.com/haskell-tls/hs-tls/pull/460)
+
+## Version 1.8.0
+
+* BREAKING CHANGE: Remove `Exception` instance for `TLSError`.
+  The library now throws `TLSException` only.
+  If you need to change your code, please refer to
+  [this example](https://github.com/snoyberg/http-client/commit/73d1a4eb451c089878ba95e96371d0b18287ffb8) first.
+  [#457](https://github.com/haskell-tls/hs-tls/pull/457)
+
+## Version 1.7.1
+
+* NOP on UserCanceled event
+  [#454](https://github.com/haskell-tls/hs-tls/pull/454)
+
+## Version 1.7.0
+
+* Major version up because "crypton" is used instead of "cryptonite"
+
+## Version 1.6.0
+
+- Major version up because of disabling SSL3
+- Some fixes against tlsfuzzer
+
+## Version 1.5.8
+
+- Require mtl-2.2.1 or newer
+  [#448](https://github.com/haskell-tls/hs-tls/pull/448)
+
+## Version 1.5.7
+
+- New APIs: getFinished and getPeerFinished
+  [#445](https://github.com/vincenthz/hs-tls/pull/445)
+
+## Version 1.5.6
+
+- Dynamically setting enctypted extensions
+  [#444](https://github.com/vincenthz/hs-tls/pull/444)
+
+## Version 1.5.5
+
+- QUIC support
+  [#419](https://github.com/vincenthz/hs-tls/pull/419)
+  [#427](https://github.com/vincenthz/hs-tls/pull/427)
+  [#428](https://github.com/vincenthz/hs-tls/pull/428)
+  [#430](https://github.com/vincenthz/hs-tls/pull/430)
+  [#433](https://github.com/vincenthz/hs-tls/pull/433)
+  [#441](https://github.com/vincenthz/hs-tls/pull/441)
+- Server ECDSA for P-256
+  [#436](https://github.com/vincenthz/hs-tls/pull/436)
+- Sort ciphersuites based on hardware-acceleration support
+  [#439](https://github.com/vincenthz/hs-tls/pull/439)
+- Sending no_application_protocol
+  [#440](https://github.com/vincenthz/hs-tls/pull/440)
+- Internal improvements
+  [#426](https://github.com/vincenthz/hs-tls/pull/426)
+  [#431](https://github.com/vincenthz/hs-tls/pull/431)
+
+## Version 1.5.4
+
+- Restore interoperability with early Java 6
+  [#422](https://github.com/vincenthz/hs-tls/pull/422)
+- Test cleanups for timeout and async usage
+  [#416](https://github.com/vincenthz/hs-tls/pull/416)
+
+## Version 1.5.3
+
+- Additional verification regarding EC signatures
+  [#412](https://github.com/vincenthz/hs-tls/pull/412)
+- Fixing ALPN
+  [#411](https://github.com/vincenthz/hs-tls/pull/411)
+- Check SSLv3 padding length
+  [#410](https://github.com/vincenthz/hs-tls/pull/410)
+- Exposing getClientCertificateChain
+  [#407](https://github.com/vincenthz/hs-tls/pull/407)
+- Extended Master Secret
+  [#406](https://github.com/vincenthz/hs-tls/pull/406)
+- Brushing up the documentation
+  [#404](https://github.com/vincenthz/hs-tls/pull/404)
+  [#408](https://github.com/vincenthz/hs-tls/pull/408)
+- Improving tests
+  [#403](https://github.com/vincenthz/hs-tls/pull/403)
+- Avoid calling onServerNameIndication twice with HRR
+  [#402](https://github.com/vincenthz/hs-tls/pull/402)
+- Enable X448 and FFDHE groups
+  [#401](https://github.com/vincenthz/hs-tls/pull/401)
+- Refactoring
+  [#400](https://github.com/vincenthz/hs-tls/pull/400)
+  [#399](https://github.com/vincenthz/hs-tls/pull/399)
+
+## Version 1.5.2
+
+- Enabled TLS 1.3 by default [#398](https://github.com/vincenthz/hs-tls/pull/398)
+- Avoid handshake failure with small RSA keys [#394](https://github.com/vincenthz/hs-tls/pull/394)
+
+NOTES:
+
+- Starting with tls-1.5.0, the parameter `supportedVersions` contains values
+  ordered by decreasing preference, so typically the higher versions first.
+  This departs from code samples previously available.  For maximum
+  interoperability, users overriding the default value should verify and adapt
+  their code.
+
+## Version 1.5.1
+
+- Post-handshake authentication [#363](https://github.com/vincenthz/hs-tls/pull/363)
+- Middlebox compatibility [#386](https://github.com/vincenthz/hs-tls/pull/386)
+- Verification and configuration of session-ticket lifetime [#373](https://github.com/vincenthz/hs-tls/pull/373)
+- Fixing memory leak [#366](https://github.com/vincenthz/hs-tls/pull/366)
+- Don't send 0-RTT data when ticket is expired [#370](https://github.com/vincenthz/hs-tls/pull/370)
+- Handshake packet fragmentation [#371](https://github.com/vincenthz/hs-tls/pull/371)
+- Fix SSLv2 deprecated header [#383](https://github.com/vincenthz/hs-tls/pull/383)
+- Other improvements to TLS 1.3 and RFC conformance [#368](https://github.com/vincenthz/hs-tls/pull/368) [#372](https://github.com/vincenthz/hs-tls/pull/372) [#375](https://github.com/vincenthz/hs-tls/pull/375) [#376](https://github.com/vincenthz/hs-tls/pull/376) [#377](https://github.com/vincenthz/hs-tls/pull/377) [#378](https://github.com/vincenthz/hs-tls/pull/378) [#380](https://github.com/vincenthz/hs-tls/pull/380) [#382](https://github.com/vincenthz/hs-tls/pull/382) [#385](https://github.com/vincenthz/hs-tls/pull/385) [#387](https://github.com/vincenthz/hs-tls/pull/387) [#388](https://github.com/vincenthz/hs-tls/pull/388)
+
+## Version 1.5.0
+
+- Add and enable AES CCM ciphers [#271](https://github.com/vincenthz/hs-tls/pull/271) [#287](https://github.com/vincenthz/hs-tls/pull/287)
+- Verify certificate key usage [#274](https://github.com/vincenthz/hs-tls/pull/274) [#301](https://github.com/vincenthz/hs-tls/pull/301)
+- TLS 1.3 support [#278](https://github.com/vincenthz/hs-tls/pull/278) [#279](https://github.com/vincenthz/hs-tls/pull/279) [#280](https://github.com/vincenthz/hs-tls/pull/280) [#283](https://github.com/vincenthz/hs-tls/pull/283) [#298](https://github.com/vincenthz/hs-tls/pull/298) [#331](https://github.com/vincenthz/hs-tls/pull/331) [#290](https://github.com/vincenthz/hs-tls/pull/290) [#314](https://github.com/vincenthz/hs-tls/pull/314)
+- Enable RSASSA-PSS [#280](https://github.com/vincenthz/hs-tls/pull/280) [#353](https://github.com/vincenthz/hs-tls/pull/353)
+- Add and enable ChaCha20-Poly1305 ciphers [#287](https://github.com/vincenthz/hs-tls/pull/287) [#340](https://github.com/vincenthz/hs-tls/pull/340)
+- Certificate selection with extension "signature_algorithms_cert" [#302](https://github.com/vincenthz/hs-tls/pull/302)
+- Preventing Logjam attack [#300](https://github.com/vincenthz/hs-tls/pull/300)
+- Downgrade protection [#308](https://github.com/vincenthz/hs-tls/pull/308)
+- Support for EdDSA certificates [#328](https://github.com/vincenthz/hs-tls/pull/328) [#353](https://github.com/vincenthz/hs-tls/pull/353)
+- Key logging [#317](https://github.com/vincenthz/hs-tls/pull/317)
+- Thread safety for writes [#329](https://github.com/vincenthz/hs-tls/pull/329)
+- Verify signature schemes and (EC)DHE groups received [#337](https://github.com/vincenthz/hs-tls/pull/337) [#338](https://github.com/vincenthz/hs-tls/pull/338)
+- Throw BadRecordMac when the decrypted record has invalid format [#347](https://github.com/vincenthz/hs-tls/pull/347)
+- Improve documentation format [#341](https://github.com/vincenthz/hs-tls/pull/341) [#343](https://github.com/vincenthz/hs-tls/pull/343)
+- Fix recvClientData with single Handshake packet [#352](https://github.com/vincenthz/hs-tls/pull/352)
+- Decrease memory footprint of SessionData values [#354](https://github.com/vincenthz/hs-tls/pull/354)
+
+FEATURES:
+
+- TLS version 1.3 is available with most features but is not enabled by default.
+  One notable omission is post-handshake authentication.  Scenarios where
+  servers previously used renegotiation to conditionally request a certificate
+  are not possible yet when `TLS13` is negotiated.  Users may enable the version
+  in `supportedVersions` only when sure post-handshake authentication is not
+  required.
+
+API CHANGES:
+
+- `SessionManager` implementations need to provide a `sessionResumeOnlyOnce`
+  function to accommodate resumption scenarios with 0-RTT data.  The function is
+  called only on the server side.
+- Data type `SessionData` is extended with four new fields for TLS version 1.3.
+  `SessionManager` implementations that serializes/deserializes `SessionData`
+  values must deal with the new fields.
+- New configuration parameters and constructors are added for TLS version 1.3
+  but the API change should be backward compatible for most use-cases.
+- Function `cipherExchangeNeedMoreData` has been removed.
+
+## Version 1.4.1
+
+- Enable X25519 in default parameters [#265](https://github.com/vincenthz/hs-tls/pull/265)
+- Checking EOF in bye [#262](https://github.com/vincenthz/hs-tls/pull/262)
+- Improving validation in DH key exchange [#256](https://github.com/vincenthz/hs-tls/pull/256)
+- Handle TCP reset during handshake [#251](https://github.com/vincenthz/hs-tls/pull/251)
+- Accepting hlint suggestions.
+
+## Version 1.4.0
+
+- Wrap renegotiation failures with HandshakeFailed [#237](https://github.com/vincenthz/hs-tls/pull/237)
+- Improve selection of server certificate and use "signature_algorithms" extension [#236](https://github.com/vincenthz/hs-tls/pull/236)
+- Change Bytes to ByteString and deprecate the Bytes type alias [#230](https://github.com/vincenthz/hs-tls/pull/230)
+- Session compression and SNI [#223](https://github.com/vincenthz/hs-tls/pull/223)
+- Deprecating ciphersuite_medium. Putting WARNING to ciphersuite_all since this includes RC4 [#153](https://github.com/vincenthz/hs-tls/pull/153) [#222](https://github.com/vincenthz/hs-tls/pull/222)
+- Removing NPN [#214](https://github.com/vincenthz/hs-tls/pull/214)
+- Supporting RSAPSS defined in TLS 1.3 [#207](https://github.com/vincenthz/hs-tls/pull/207)
+- Supporting X25519 and X448 in the IES style. [#205](https://github.com/vincenthz/hs-tls/pull/205)
+- Strip leading zeros in DHE premaster secret [#201](https://github.com/vincenthz/hs-tls/pull/201)
+
+FEATURES:
+
+- RSASSA-PSS signatures can be enabled with `supportedHashSignatures`.  This
+  uses assignments from TLS 1.3, for example `(HashIntrinsic, SignatureRSApssSHA256)`.
+- Diffie-Hellman with elliptic curves X25519 and X448: This can be enabled with
+  `supportedGroups`, which also gives control over curve preference.
+- ECDH with curve P-256 now uses optimized C implementation from package `cryptonite`.
+
+API CHANGES:
+
+- Cipher list `ciphersuite_medium` is now deprecated, users are advised to use
+  `ciphersuite_default` or `ciphersuite_strong`.  List `ciphersuite_all` is kept
+  for compatibility with old servers but this is discouraged and generates a
+  warning (this includes RC4 ciphers, see [#153](https://github.com/vincenthz/hs-tls/pull/153)
+  for reference).
+- Support for NPN (Next Protocol Negotiation) has been removed. The replacement
+  is ALPN (Application-Layer Protocol Negotiation).
+- Data type `SessionData` now contains fields for compression algorithm and
+  client SNI.  A `SessionManager` implementation that serializes/deserializes
+  `SessionData` values must deal with the new fields.
+- Module `Network.TLS` exports a type alias named `Bytes` which is now deprecated.
+  The replacement is to use strict `ByteString` directly.
+
+## Version 1.3.11
+
+- Using reliable versions of dependent libraries.
+
+## Version 1.3.10
+
+- Selecting a cipher based on "signature_algorithms" [#193](https://github.com/vincenthz/hs-tls/pull/193)
+- Respecting the "signature_algorithms" extension [#137](https://github.com/vincenthz/hs-tls/pull/137)
+- Fix RSA signature in CertificateVerify with TLS < 1.2 [#189](https://github.com/vincenthz/hs-tls/pull/189)
+- Fix ECDSA with TLS 1.0 / TLS 1.1 [#187](https://github.com/vincenthz/hs-tls/pull/187)
+- Sending an empty server name from a server if necessary. [#175](https://github.com/vincenthz/hs-tls/pull/175)
+- `Network.TLS.Extra` provides Finite Field Diffie-Hellman Ephemeral Parameters in RFC 7919 [#174](https://github.com/vincenthz/hs-tls/pull/174)
+- Restore ability to renegotiate[#164](https://github.com/vincenthz/hs-tls/pull/164)
+
+## Version 1.3.9
+
+- Drop support for old GHC.
+- Enable sha384 ciphers and provide `ciphersuite_default` as default set of ciphers for common needs [#168](https://github.com/vincenthz/hs-tls/pull/168)
+- SNI late checks [#147](https://github.com/vincenthz/hs-tls/pull/147)
+- Expose the HasBackend(..) class fully, so that developers can use TLS over their own channels [#149](https://github.com/vincenthz/hs-tls/pull/149)
+
+## Version 1.3.8
+
+- Fix older GHC builds
+
+## Version 1.3.7
+
+- Disable SHA384 based cipher, as they don't work properly yet.
+
+## Version 1.3.6
+
+- Add new ciphers
+- Improve some debugging and outputs
+
+## Version 1.3.5
+
+- Fix a bug with ECDHE based cipher where serialization
+- Debugging: Add a way to print random seed and a way to side-load a seed for replayability
+- Improve tests
+
+## Version 1.3.4
+
+- Fix tests on 32 bits `time_t` machines (time not within bound)
+- VirtualHost: Add a way to load credentials related to the hostname used by the client (Julian Beaumont)
+- VirtualHost: Expose an API to query which hostname the client has contacted (Julian Beaumont)
+- Add a way to disable empty packet that are use for security when
+  using old versions + old CBC based cipher (Anton Dessiatov)
+
+## Version 1.3.3
+
+- Add support for Hans (Haskell Network Stack) (Adam Wick)
+- Add support for ECDSA signature
+- Add support for ECDSA-ECDHE Cipher
+- Improve parsing of ECC related structure
+
+## Version 1.3.2
+
+- Add cipher suites for forward secrecy on more clients (Aaron Friel)
+- Maintain more handshake information to be queried by protocol (Adam Wick)
+- handle SCSV on client and server side (Kazu Yamamoto)
+- Cleanup renegotiation logic (Kazu Yamamoto)
+- Various testing improvements with the openssl test parts
+- Cleanup AEAD handling for future support of other ciphers
+
+## Version 1.3.1
+
+- Repair DHE RSA handling on the cipher by creating signature properly
+
+## Version 1.3.0
+
+- modernize the crypto stack by using cryptonite.
+
+## Version 1.2.18
+
+- add more tests (network, local)
+- cleanup cipher / bulk code, certificate verify / creation, and digitall signed handling
+- fix handling of DHE ciphers with MS SSL stack that serialize leading zero.
+
+## Version 1.2.17
+
+- Fix an issue of type of key / hash that prevented connection with SChannel.
+
+## Version 1.2.16
+
+- Fix an issue with stream cipher not correctly calculating the internal state,
+  resulting systematically in bad record mac failure during handshake
+
+## Version 1.2.15
+
+- support chain certificate in credentials
+
+## Version 1.2.14
+
+- adding ALPN extension
+- adding support for AEAD, and particularly AES128-GCM
+- Adding support for ECDH
+- Do not support SSL3 by default for security reason.
+- add EnumSafe8 and 16 for specific sized Enum instance that are safer
+- export signatureAndHash parser/encoder
+- add a "known" list of extensions
+- add SignatureAlgorithms extension
+- add Heartbeat extension
+- add support for EC curves and point format extensions
+- add preliminary SessionTicket extension
+- Debug: Add the ability to choose arbitrary cipher in the client hello.
+
+## Version 1.2.13
+
+- Fix compilation with old mtl version
+
+## Version 1.2.12
+
+- Propagate asynchronous exception
+
+## Version 1.2.11
+
+- use hourglass instead of time
+- use tasty instead of test-framework
+- add travis file
+- remove old de-optimisation flag as the bytestring bug is old now and it conflict with cabal check
+
+## Version 1.2.10
+
+- Update x509 dependencies
+
+## Version 1.2.9
+
+- Export TLSParams and HasBackend type names
+- Added FlexibleContexts flag required by ghc-7.9
+- debug: add support for specifying the timeout length in milliseconds.
+- debug: add support for 3DES in simple client
+
+## Version 1.2.8
+
+- add support for 3DES-EDE-CBC-SHA1 (cipher 0xa)
+
+## Version 1.2.7
+
+- repair retrieve certificate validation, and improve fingerprints
+- remove groom from dependency
+- make RecordM an instance of Applicative
+- Fixes the Error_EOF partial pattern match error in exception handling
+
 ## Version 1.2.6 (23 Mar 2014)
 
 - Fixed socket backend endless loop when the server does not close connection
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2010-2012 Vincent Hanquez <vincent@snarc.org>
+Copyright (c) 2010-2015 Vincent Hanquez <vincent@snarc.org>
 
 All rights reserved.
 
diff --git a/Network/TLS.hs b/Network/TLS.hs
--- a/Network/TLS.hs
+++ b/Network/TLS.hs
@@ -1,128 +1,377 @@
 -- |
--- Module      : Network.TLS
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
+-- Native Haskell TLS protocol implementation for servers and
+-- clients.
 --
-module Network.TLS
-    (
-    -- * Context configuration
-      ClientParams(..)
-    , ServerParams(..)
-    , ClientHooks(..)
-    , ServerHooks(..)
-    , Supported(..)
-    , Shared(..)
-    , Hooks(..)
-    , Logging(..)
-    , Measurement(..)
-    , CertificateUsage(..)
-    , CertificateRejectReason(..)
-    , defaultParamsClient
-    , MaxFragmentEnum(..)
-    , HashAndSignatureAlgorithm
-    , HashAlgorithm(..)
-    , SignatureAlgorithm(..)
-    , CertificateType(..)
-
-    -- * raw types
-    , ProtocolType(..)
-    , Header(..)
+-- This provides a high-level implementation of a sensitive security
+-- protocol, eliminating a common set of security issues through the
+-- use of the advanced type system, high level constructions and
+-- common Haskell features.
+--
+-- Currently implement the TLS1.2 and TLS 1.3
+-- protocol, and support RSA and Ephemeral (Elliptic curve and
+-- regular) Diffie Hellman key exchanges, and many extensions.
+--
+-- The typical usage is:
+--
+-- > socket <- ...
+-- > ctx <- contextNew socket <params>
+-- > handshake ctx
+-- > ... (using recvData and sendData)
+-- > bye
+module Network.TLS (
+    -- * Basic APIs
+    Context,
+    contextNew,
+    handshake,
+    sendData,
+    recvData,
+    bye,
 
-    -- * Session
-    , SessionID
-    , SessionData(..)
-    , SessionManager(..)
-    , noSessionManager
+    -- * Exceptions
+    -- $exceptions
 
     -- * Backend abstraction
-    , Backend(..)
+    HasBackend (..),
+    Backend (..),
 
-    -- * Context object
-    , Context
-    , ctxConnection
+    -- * Parameters
 
-    -- * Creating a context
-    , contextNew
-    , contextNewOnHandle
-    , contextNewOnSocket
-    , contextFlush
-    , contextClose
-    , contextHookSetHandshakeRecv
-    , contextHookSetCertificateRecv
-    , contextHookSetLogging
-    , contextModifyHooks
+    -- intentionally hide the internal methods even haddock warns.
+    TLSParams,
 
-    -- * Information gathering
-    , Information(..)
-    , contextGetInformation
+    -- ** Client parameters
+    ClientParams,
+    defaultParamsClient,
+    clientServerIdentification,
+    clientUseServerNameIndication,
+    clientWantSessionResume,
+    clientWantSessionResumeList,
+    clientWantTicket,
+    clientShared,
+    clientHooks,
+    clientSupported,
+    clientDebug,
+    clientUseEarlyData,
+    clientUseECH,
 
-    -- * Credentials
-    , Credentials(..)
-    , Credential
-    , credentialLoadX509
-    , credentialLoadX509FromMemory
+    -- ** Server parameters
+    ServerParams,
+    defaultParamsServer,
+    serverWantClientCert,
+    serverCACertificates,
+    serverDHEParams,
+    serverHooks,
+    serverShared,
+    serverSupported,
+    serverDebug,
+    serverEarlyDataSize,
+    serverTicketLifetime,
+    serverECHKey,
 
-    -- * Initialisation and Termination of context
-    , bye
-    , handshake
+    -- ** Shared
+    Shared,
+    defaultShared,
+    sharedCredentials,
+    sharedSessionManager,
+    sharedCAStore,
+    sharedValidationCache,
+    sharedHelloExtensions,
+    sharedECHConfigList,
+    sharedLimit,
 
-    -- * Next Protocol Negotiation
-    , getNegotiatedProtocol
+    -- ** Client hooks
+    ClientHooks,
+    defaultClientHooks,
+    OnCertificateRequest,
+    onCertificateRequest,
+    OnServerCertificate,
+    onServerCertificate,
+    onSuggestALPN,
+    onCustomFFDHEGroup,
+    onServerFinished,
+    onSelectKeyShareGroups,
 
-    -- * High level API
-    , sendData
-    , recvData
-    , recvData'
+    -- ** Server hooks
+    ServerHooks,
+    defaultServerHooks,
+    onClientCertificate,
+    validateClientCertificate,
+    onUnverifiedClientCert,
+    onCipherChoosing,
+    onServerNameIndication,
+    onNewHandshake,
+    onALPNClientSuggest,
+    onEncryptedExtensionsCreating,
+    onSelectKeyShare,
+    Measurement,
+    nbHandshakes,
+    bytesReceived,
+    bytesSent,
 
-    -- * Crypto Key
-    , PubKey(..)
-    , PrivKey(..)
+    -- ** Supported
+    Supported,
+    defaultSupported,
+    supportedVersions,
+    supportedCiphers,
+    supportedCompressions,
+    supportedHashSignatures,
+    supportedSecureRenegotiation,
+    supportedClientInitiatedRenegotiation,
+    supportedExtendedMainSecret,
+    supportedSession,
+    supportedFallbackScsv,
+    supportedEmptyPacket,
+    supportedGroups,
+    supportedGroupsTLS13,
 
-    -- * Compressions & Predefined compressions
-    , module Network.TLS.Compression
+    -- ** Debug parameters
+    DebugParams,
+    defaultDebugParams,
+    debugSeed,
+    debugPrintSeed,
+    debugVersionForced,
+    debugKeyLogger,
+    defaultKeyLogger,
+    debugError,
+    debugTraceKey,
 
-    -- * Ciphers & Predefined ciphers
-    , module Network.TLS.Cipher
+    -- ** Limit parameters
+    Limit,
+    defaultLimit,
+    limitHandshakeFragment,
+    limitRecordSize,
 
-    -- * Versions
-    , Version(..)
+    -- * Shared parameters
 
-    -- * Errors
-    , TLSError(..)
-    , KxError(..)
-    , AlertDescription(..)
+    -- ** Credentials
+    Credentials (..),
+    Credential,
+    credentialLoadX509,
+    credentialLoadX509FromMemory,
+    credentialLoadX509Chain,
+    credentialLoadX509ChainFromMemory,
 
-    -- * Exceptions
-    , TLSException(..)
+    -- ** Session manager
+    SessionManager,
+    noSessionManager,
+    sessionResume,
+    sessionResumeOnlyOnce,
+    sessionEstablish,
+    sessionInvalidate,
+    sessionUseTicket,
+    SessionID,
+    SessionIDorTicket,
+    Ticket,
 
-    -- * X509 Validation
-    , ValidationChecks(..)
-    , ValidationHooks(..)
+    -- ** Session data
+    SessionData,
+    sessionVersion,
+    sessionCipher,
+    sessionCompression,
+    sessionClientSNI,
+    sessionSecret,
+    sessionGroup,
+    sessionTicketInfo,
+    sessionALPN,
+    sessionMaxEarlyDataSize,
+    sessionFlags,
+    SessionFlag (..),
+    TLS13TicketInfo,
+    is0RTTPossible,
 
-    -- * X509 Validation Cache
-    , ValidationCache(..)
-    , ValidationCacheResult(..)
-    , exceptionValidationCache
-    ) where
+    -- ** Validation Cache
+    ValidationCache (..),
+    defaultValidationCache,
+    ValidationCacheQueryCallback,
+    ValidationCacheAddCallback,
+    ValidationCacheResult (..),
+    exceptionValidationCache,
 
-import Network.TLS.Backend (Backend(..))
-import Network.TLS.Struct ( TLSError(..), TLSException(..)
-                          , HashAndSignatureAlgorithm, HashAlgorithm(..), SignatureAlgorithm(..)
-                          , Header(..), ProtocolType(..), CertificateType(..)
-                          , AlertDescription(..))
-import Network.TLS.Crypto (KxError(..))
+    -- * Types
+
+    -- ** For 'Supported'
+    Version (..),
+    Compression (..),
+    nullCompression,
+    HashAndSignatureAlgorithm,
+    supportedSignatureSchemes,
+    HashAlgorithm (..),
+    SignatureAlgorithm (..),
+    Group (..),
+    supportedNamedGroups,
+    EMSMode (..),
+
+    -- ** For parameters and hooks
+    DHParams,
+    DHPublic,
+    GroupUsage (..),
+    CertificateUsage (..),
+    CertificateRejectReason (..),
+    CertificateType (..),
+    CertificateChain (..),
+    HostName,
+    MaxFragmentEnum (..),
+
+    -- * Advanced APIs
+
+    -- ** Backend
+    ctxBackend,
+    contextFlush,
+    contextClose,
+
+    -- ** Information gathering
+    Information,
+    contextGetInformation,
+    infoVersion,
+    infoCipher,
+    infoCompression,
+    infoMainSecret,
+    infoExtendedMainSecret,
+    infoClientRandom,
+    infoServerRandom,
+    infoSupportedGroup,
+    infoTLS12Resumption,
+    infoTLS13HandshakeMode,
+    infoIsEarlyDataAccepted,
+    infoIsECHAccepted,
+    ClientRandom,
+    ServerRandom,
+    unClientRandom,
+    unServerRandom,
+    HandshakeMode13 (..),
+    getClientCertificateChain,
+    getServerCertificateChain,
+
+    -- ** Negotiated
+    getNegotiatedProtocol,
+    getClientSNI,
+
+    -- ** Post-handshake actions
+    updateKey,
+    KeyUpdateRequest (..),
+    requestCertificate,
+    getTLSUnique,
+    getTLSExporter,
+    getTLSServerEndPoint,
+    getFinished,
+    getPeerFinished,
+
+    -- ** Modifying hooks in context
+    Hooks,
+    defaultHooks,
+    hookRecvHandshake,
+    hookRecvHandshake13,
+    hookRecvCertificates,
+    hookLogging,
+    contextModifyHooks,
+    Handshake,
+    contextHookSetHandshakeRecv,
+    Handshake13,
+    contextHookSetHandshake13Recv,
+    contextHookSetCertificateRecv,
+    Logging,
+    defaultLogging,
+    loggingPacketSent,
+    loggingPacketRecv,
+    loggingIOSent,
+    loggingIORecv,
+    Header (..),
+    ProtocolType (..),
+    contextHookSetLogging,
+
+    -- * Errors and exceptions
+
+    -- ** Errors
+    TLSError (..),
+    KxError (..),
+    AlertDescription (..),
+
+    -- ** Exceptions
+    TLSException (..),
+
+    -- * Raw types
+
+    -- ** Compressions class
+    CompressionC (..),
+    CompressionID,
+
+    -- ** Crypto Key
+    PubKey (..),
+    PrivKey (..),
+
+    -- ** Ciphers & Predefined ciphers
+    module Network.TLS.Cipher,
+
+    -- * Deprecated
+    recvData',
+    Bytes,
+    ValidationChecks (..),
+    ValidationHooks (..),
+    clientUseMaxFragmentLength,
+) where
+
+import Data.X509 (PrivKey (..), PubKey (..))
+import Data.X509.Validation hiding (HostName, defaultHooks)
+
+import Network.TLS.Backend (Backend (..), HasBackend (..))
 import Network.TLS.Cipher
+import Network.TLS.Compression (
+    Compression (..),
+    CompressionC (..),
+    nullCompression,
+ )
+import Network.TLS.Context
+import Network.TLS.Core
+import Network.TLS.Credentials
+import Network.TLS.Crypto (
+    DHParams,
+    DHPublic,
+    KxError (..),
+    supportedNamedGroups,
+ )
+import Network.TLS.Extension
+import Network.TLS.Handshake.State (HandshakeMode13 (..))
 import Network.TLS.Hooks
+import Network.TLS.Imports
 import Network.TLS.Measurement
-import Network.TLS.Credentials
-import Network.TLS.Compression (CompressionC(..), Compression(..), nullCompression)
-import Network.TLS.Context
 import Network.TLS.Parameters
-import Network.TLS.Core
 import Network.TLS.Session
-import Network.TLS.X509
+import qualified Network.TLS.State as S
+import Network.TLS.Struct (
+    AlertDescription (..),
+    CertificateType (..),
+    ClientRandom (..),
+    Handshake,
+    HashAlgorithm (..),
+    HashAndSignatureAlgorithm,
+    Header (..),
+    ProtocolType (..),
+    ServerRandom (..),
+    SignatureAlgorithm (..),
+    TLSError (..),
+    TLSException (..),
+    supportedSignatureSchemes,
+ )
+import Network.TLS.Struct13 (Handshake13)
 import Network.TLS.Types
-import Data.X509 (PubKey(..), PrivKey(..))
-import Data.X509.Validation
+import Network.TLS.X509
+
+{-# DEPRECATED Bytes "Use Data.ByteString.Bytestring instead of Bytes." #-}
+type Bytes = ByteString
+
+-- | Getting certificates from a client, if any.
+--   Note that the certificates are not sent by a client
+--   on resumption even if client authentication is required.
+--   So, this API would be replaced by the one which can treat
+--   both cases of full-negotiation and resumption.
+getClientCertificateChain :: Context -> IO (Maybe CertificateChain)
+getClientCertificateChain ctx = usingState_ ctx S.getClientCertificateChain
+
+getServerCertificateChain :: Context -> IO (Maybe CertificateChain)
+getServerCertificateChain ctx = usingState_ ctx S.getServerCertificateChain
+
+-- $exceptions
+--     Since 1.8.0, this library only throws exceptions of type 'TLSException'.
+--     In the common case where the chosen backend is socket, 'IOException'
+--     may be thrown as well. This happens because the backend for sockets,
+--     opaque to most modules in the @tls@ library, throws those exceptions.
diff --git a/Network/TLS/Backend.hs b/Network/TLS/Backend.hs
--- a/Network/TLS/Backend.hs
+++ b/Network/TLS/Backend.hs
@@ -1,11 +1,4 @@
--- |
--- Module      : Network.TLS.Backend
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- A Backend represents a unified way to do IO on different
+-- | A Backend represents a unified way to do IO on different
 -- types without burdening our calling API with multiple
 -- ways to initialize a new context.
 --
@@ -14,25 +7,28 @@
 -- * a way to write data
 -- * a way to close the stream
 -- * a way to flush the stream
---
-module Network.TLS.Backend
-    ( HasBackend(..)
-    , Backend(..)
-    ) where
+module Network.TLS.Backend (
+    HasBackend (..),
+    Backend (..),
+) where
 
-import Control.Monad
-import Network.Socket (Socket, sClose)
-import qualified Network.Socket.ByteString as Socket
-import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
-import System.IO (Handle, hSetBuffering, BufferMode(..), hFlush, hClose)
+import qualified Network.Socket as Network
+import qualified Network.Socket.ByteString as Network
+import System.IO (BufferMode (..), Handle, hClose, hFlush, hSetBuffering)
 
+import Network.TLS.Imports
+
 -- | Connection IO backend
 data Backend = Backend
-    { backendFlush :: IO ()                -- ^ Flush the connection sending buffer, if any.
-    , backendClose :: IO ()                -- ^ Close the connection.
-    , backendSend  :: ByteString -> IO ()  -- ^ Send a bytestring through the connection.
-    , backendRecv  :: Int -> IO ByteString -- ^ Receive specified number of bytes from the connection.
+    { backendFlush :: IO ()
+    -- ^ Flush the connection sending buffer, if any.
+    , backendClose :: IO ()
+    -- ^ Close the connection.
+    , backendSend :: ByteString -> IO ()
+    -- ^ Send a bytestring through the connection.
+    , backendRecv :: Int -> IO ByteString
+    -- ^ Receive specified number of bytes from the connection.
     }
 
 class HasBackend a where
@@ -43,17 +39,34 @@
     initializeBackend _ = return ()
     getBackend = id
 
-instance HasBackend Socket where
+safeRecv :: Network.Socket -> Int -> IO ByteString
+safeRecv = Network.recv
+
+instance HasBackend Network.Socket where
     initializeBackend _ = return ()
-    getBackend sock = Backend (return ()) (sClose sock) (Socket.sendAll sock) recvAll
-      where recvAll n = B.concat `fmap` loop n
-              where loop 0    = return []
-                    loop left = do
-                        r <- Socket.recv sock left
-                        if B.null r
-                            then return []
-                            else liftM (r:) (loop (left - B.length r))
+    getBackend sock =
+        Backend
+            { backendFlush = return ()
+            , backendClose = Network.close sock
+            , backendSend = Network.sendAll sock
+            , backendRecv = recvAll
+            }
+      where
+        recvAll n = B.concat <$> loop n
+          where
+            loop 0 = return []
+            loop left = do
+                r <- safeRecv sock left
+                if B.null r
+                    then return []
+                    else (r :) <$> loop (left - B.length r)
 
 instance HasBackend Handle where
     initializeBackend handle = hSetBuffering handle NoBuffering
-    getBackend handle = Backend (hFlush handle) (hClose handle) (B.hPut handle) (B.hGet handle)
+    getBackend handle =
+        Backend
+            { backendFlush = hFlush handle
+            , backendClose = hClose handle
+            , backendSend = B.hPut handle
+            , backendRecv = B.hGet handle
+            }
diff --git a/Network/TLS/Cap.hs b/Network/TLS/Cap.hs
deleted file mode 100644
--- a/Network/TLS/Cap.hs
+++ /dev/null
@@ -1,19 +0,0 @@
--- |
--- Module      : Network.TLS.Cap
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-
-module Network.TLS.Cap
-    ( hasHelloExtensions
-    , hasExplicitBlockIV
-    ) where
-
-import Network.TLS.Struct
-
-hasHelloExtensions, hasExplicitBlockIV :: Version -> Bool
-
-hasHelloExtensions ver = ver >= SSL3
-hasExplicitBlockIV ver = ver >= TLS11
diff --git a/Network/TLS/Cipher.hs b/Network/TLS/Cipher.hs
--- a/Network/TLS/Cipher.hs
+++ b/Network/TLS/Cipher.hs
@@ -1,119 +1,84 @@
-{-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE ExistentialQuantification #-}
--- |
--- Module      : Network.TLS.Cipher
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Cipher
-    ( BulkFunctions(..)
-    , CipherKeyExchangeType(..)
-    , Bulk(..)
-    , Hash(..)
-    , Cipher(..)
-    , CipherID
-    , Key
-    , IV
-    , cipherKeyBlockSize
-    , cipherAllowedForVersion
-    , cipherExchangeNeedMoreData
-    ) where
-
-import Network.TLS.Types (CipherID)
-import Network.TLS.Struct (Version(..))
-
-import qualified Data.ByteString as B
-
--- FIXME convert to newtype
-type Key = B.ByteString
-type IV = B.ByteString
-
-data BulkFunctions =
-      BulkBlockF (Key -> IV -> B.ByteString -> B.ByteString)
-                 (Key -> IV -> B.ByteString -> B.ByteString)
-    | BulkStreamF (Key -> IV)
-                  (IV -> B.ByteString -> (B.ByteString, IV))
-                  (IV -> B.ByteString -> (B.ByteString, IV))
+{-# OPTIONS_HADDOCK hide #-}
 
-data CipherKeyExchangeType =
-      CipherKeyExchange_RSA
-    | CipherKeyExchange_DH_Anon
-    | CipherKeyExchange_DHE_RSA
-    | CipherKeyExchange_ECDHE_RSA
-    | CipherKeyExchange_DHE_DSS
-    | CipherKeyExchange_DH_DSS
-    | CipherKeyExchange_DH_RSA
-    | CipherKeyExchange_ECDH_ECDSA
-    | CipherKeyExchange_ECDH_RSA
-    | CipherKeyExchange_ECDHE_ECDSA
-    deriving (Show,Eq)
+module Network.TLS.Cipher (
+    CipherKeyExchangeType (..),
+    Bulk (..),
+    BulkFunctions (..),
+    BulkDirection (..),
+    BulkState (..),
+    BulkStream (..),
+    BulkBlock,
+    BulkAEAD,
+    bulkInit,
+    Hash (..),
+    Cipher (..),
+    CipherID,
+    cipherKeyBlockSize,
+    BulkKey,
+    BulkIV,
+    BulkNonce,
+    BulkAdditionalData,
+    cipherAllowedForVersion,
+    hasMAC,
+    hasRecordIV,
+    elemCipher,
+    intersectCiphers,
+    findCipher,
+) where
 
-data Bulk = Bulk
-    { bulkName         :: String
-    , bulkKeySize      :: Int
-    , bulkIVSize       :: Int
-    , bulkBlockSize    :: Int
-    , bulkF            :: BulkFunctions
-    }
+import Network.TLS.Crypto (Hash (..), hashDigestSize)
+import Network.TLS.Imports
+import Network.TLS.Types
 
-instance Show Bulk where
-    show bulk = bulkName bulk
-instance Eq Bulk where
-    b1 == b2 = and [ bulkName b1 == bulkName b2
-                   , bulkKeySize b1 == bulkKeySize b2
-                   , bulkIVSize b1 == bulkIVSize b2
-                   , bulkBlockSize b1 == bulkBlockSize b2
-                   ]
+data BulkState
+    = BulkStateStream BulkStream
+    | BulkStateBlock BulkBlock
+    | BulkStateAEAD BulkAEAD
+    | BulkStateUninitialized
 
-data Hash = Hash
-    { hashName         :: String
-    , hashSize         :: Int
-    , hashF            :: B.ByteString -> B.ByteString
-    }
+instance Show BulkState where
+    show (BulkStateStream _) = "BulkStateStream"
+    show (BulkStateBlock _) = "BulkStateBlock"
+    show (BulkStateAEAD _) = "BulkStateAEAD"
+    show BulkStateUninitialized = "BulkStateUninitialized"
 
-instance Show Hash where
-    show hash = hashName hash
-instance Eq Hash where
-    h1 == h2 = hashName h1 == hashName h2 && hashSize h1 == hashSize h2
+bulkInit :: Bulk -> BulkDirection -> BulkKey -> BulkState
+bulkInit bulk direction key =
+    case bulkF bulk of
+        BulkBlockF ini -> BulkStateBlock (ini direction key)
+        BulkStreamF ini -> BulkStateStream (ini direction key)
+        BulkAeadF ini -> BulkStateAEAD (ini direction key)
 
--- | Cipher algorithm
-data Cipher = Cipher
-    { cipherID           :: CipherID
-    , cipherName         :: String
-    , cipherHash         :: Hash
-    , cipherBulk         :: Bulk
-    , cipherKeyExchange  :: CipherKeyExchangeType
-    , cipherMinVer       :: Maybe Version
-    }
+hasMAC, hasRecordIV :: BulkFunctions -> Bool
+hasMAC (BulkBlockF _) = True
+hasMAC (BulkStreamF _) = True
+hasMAC (BulkAeadF _) = False
+hasRecordIV = hasMAC
 
 cipherKeyBlockSize :: Cipher -> Int
-cipherKeyBlockSize cipher = 2 * (hashSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk)
-  where bulk = cipherBulk cipher
+cipherKeyBlockSize cipher = 2 * (hashDigestSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk)
+  where
+    bulk = cipherBulk cipher
 
 -- | Check if a specific 'Cipher' is allowed to be used
 -- with the version specified
 cipherAllowedForVersion :: Version -> Cipher -> Bool
 cipherAllowedForVersion ver cipher =
     case cipherMinVer cipher of
-        Nothing   -> True
-        Just cVer -> cVer <= ver
+        Nothing -> ver < TLS13
+        Just cVer -> cVer <= ver && (ver < TLS13 || cVer >= TLS13)
 
-instance Show Cipher where
-    show c = cipherName c
+eqCipher :: CipherID -> Cipher -> Bool
+eqCipher cid c = cipherID c == cid
 
-instance Eq Cipher where
-    (==) c1 c2 = cipherID c1 == cipherID c2
+elemCipher :: [CipherId] -> Cipher -> Bool
+elemCipher cids c = cid `elem` cids
+  where
+    cid = CipherId $ cipherID c
 
-cipherExchangeNeedMoreData :: CipherKeyExchangeType -> Bool
-cipherExchangeNeedMoreData CipherKeyExchange_RSA         = False
-cipherExchangeNeedMoreData CipherKeyExchange_DH_Anon     = True
-cipherExchangeNeedMoreData CipherKeyExchange_DHE_RSA     = True
-cipherExchangeNeedMoreData CipherKeyExchange_ECDHE_RSA   = True
-cipherExchangeNeedMoreData CipherKeyExchange_DHE_DSS     = True
-cipherExchangeNeedMoreData CipherKeyExchange_DH_DSS      = False
-cipherExchangeNeedMoreData CipherKeyExchange_DH_RSA      = False
-cipherExchangeNeedMoreData CipherKeyExchange_ECDH_ECDSA  = True
-cipherExchangeNeedMoreData CipherKeyExchange_ECDH_RSA    = True
-cipherExchangeNeedMoreData CipherKeyExchange_ECDHE_ECDSA = True
+intersectCiphers :: [CipherId] -> [Cipher] -> [Cipher]
+intersectCiphers peerCiphers myCiphers = filter (elemCipher peerCiphers) myCiphers
+
+findCipher :: CipherID -> [Cipher] -> Maybe Cipher
+findCipher cid = find $ eqCipher cid
diff --git a/Network/TLS/Compression.hs b/Network/TLS/Compression.hs
--- a/Network/TLS/Compression.hs
+++ b/Network/TLS/Compression.hs
@@ -1,41 +1,35 @@
-{-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE ExistentialQuantification #-}
--- |
--- Module      : Network.TLS.Compression
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Compression
-    ( CompressionC(..)
-    , Compression(..)
-    , CompressionID
-    , nullCompression
-    , NullCompression
+{-# OPTIONS_HADDOCK hide #-}
 
+module Network.TLS.Compression (
+    CompressionC (..),
+    Compression (..),
+    CompressionID,
+    nullCompression,
+    NullCompression,
+
     -- * member redefined for the class abstraction
-    , compressionID
-    , compressionDeflate
-    , compressionInflate
+    compressionID,
+    compressionDeflate,
+    compressionInflate,
 
     -- * helper
-    , compressionIntersectID
-    ) where
+    compressionIntersectID,
+) where
 
-import Data.Word
-import Network.TLS.Types (CompressionID)
-import Data.ByteString (ByteString)
 import Control.Arrow (first)
 
+import Network.TLS.Imports
+import Network.TLS.Types (CompressionID)
+
 -- | supported compression algorithms need to be part of this class
 class CompressionC a where
-    compressionCID      :: a -> CompressionID
+    compressionCID :: a -> CompressionID
     compressionCDeflate :: a -> ByteString -> (a, ByteString)
     compressionCInflate :: a -> ByteString -> (a, ByteString)
 
 -- | every compression need to be wrapped in this, to fit in structure
-data Compression = forall a . CompressionC a => Compression a
+data Compression = forall a. CompressionC a => Compression a
 
 -- | return the associated ID for this algorithm
 compressionID :: Compression -> CompressionID
@@ -57,16 +51,16 @@
     (==) c1 c2 = compressionID c1 == compressionID c2
 
 -- | intersect a list of ids commonly given by the other side with a list of compression
--- the function keeps the list of compression in order, to be able to find quickly the prefered
+-- the function keeps the list of compression in order, to be able to find quickly the preferred
 -- compression.
 compressionIntersectID :: [Compression] -> [Word8] -> [Compression]
-compressionIntersectID l ids = filter (\c -> elem (compressionID c) ids) l
+compressionIntersectID l ids = filter (\c -> compressionID c `elem` ids) l
 
 -- | This is the default compression which is a NOOP.
 data NullCompression = NullCompression
 
 instance CompressionC NullCompression where
-    compressionCID _        = 0
+    compressionCID _ = 0
     compressionCDeflate s b = (s, b)
     compressionCInflate s b = (s, b)
 
diff --git a/Network/TLS/Context.hs b/Network/TLS/Context.hs
--- a/Network/TLS/Context.hs
+++ b/Network/TLS/Context.hs
@@ -1,217 +1,311 @@
--- |
--- Module      : Network.TLS.Context
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Context
-    (
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Context (
     -- * Context configuration
-      TLSParams
+    TLSParams,
 
     -- * Context object and accessor
-    , Context(..)
-    , Hooks(..)
-    , ctxEOF
-    , ctxHasSSLv2ClientHello
-    , ctxDisableSSLv2ClientHello
-    , ctxEstablished
-    , withLog
-    , ctxWithHooks
-    , contextModifyHooks
-    , setEOF
-    , setEstablished
-    , contextFlush
-    , contextClose
-    , contextSend
-    , contextRecv
-    , updateMeasure
-    , withMeasure
-    , withReadLock
-    , withWriteLock
-    , withStateLock
-    , withRWLock
+    Context (..),
+    Hooks (..),
+    Established (..),
+    RecordLayer (..),
+    ctxEOF,
+    ctxEstablished,
+    withLog,
+    ctxWithHooks,
+    contextModifyHooks,
+    setEOF,
+    setEstablished,
+    contextFlush,
+    contextClose,
+    contextSend,
+    contextRecv,
+    updateMeasure,
+    withMeasure,
+    withReadLock,
+    withWriteLock,
+    withStateLock,
+    withRWLock,
 
     -- * information
-    , Information(..)
-    , contextGetInformation
+    Information (..),
+    contextGetInformation,
 
     -- * New contexts
-    , contextNew
-    -- * Deprecated new contexts methods
-    , contextNewOnHandle
-    , contextNewOnSocket
+    contextNew,
 
     -- * Context hooks
-    , contextHookSetHandshakeRecv
-    , contextHookSetCertificateRecv
-    , contextHookSetLogging
+    contextHookSetHandshakeRecv,
+    contextHookSetHandshake13Recv,
+    contextHookSetCertificateRecv,
+    contextHookSetLogging,
 
     -- * Using context states
-    , throwCore
-    , usingState
-    , usingState_
-    , runTxState
-    , runRxState
-    , usingHState
-    , getHState
-    , getStateRNG
-    ) where
+    throwCore,
+    usingState,
+    usingState_,
+    runTxRecordState,
+    runRxRecordState,
+    usingHState,
+    getHState,
+    getStateRNG,
+    tls13orLater,
+    getTLSUnique,
+    getTLSExporter,
+    getTLSServerEndPoint,
+    getFinished,
+    getPeerFinished,
+    TLS13State (..),
+    getTLS13State,
+    modifyTLS13State,
+    setMyRecordLimit,
+    enableMyRecordLimit,
+    getMyRecordLimit,
+    checkMyRecordLimit,
+    setPeerRecordLimit,
+    enablePeerRecordLimit,
+    getPeerRecordLimit,
+    checkPeerRecordLimit,
+    newRecordLimitRef,
+) where
 
+import Control.Concurrent.MVar
+import Control.Monad.State.Strict
+import Data.IORef
+
 import Network.TLS.Backend
+import Network.TLS.Cipher
 import Network.TLS.Context.Internal
-import Network.TLS.Struct
-import Network.TLS.Cipher (Cipher(..), CipherKeyExchangeType(..))
-import Network.TLS.Credentials
-import Network.TLS.State
+import Network.TLS.Crypto
+import Network.TLS.Handshake (
+    handshakeClient,
+    handshakeClientWith,
+    handshakeServer,
+    handshakeServerWith,
+ )
+import Network.TLS.Handshake.State13
 import Network.TLS.Hooks
-import Network.TLS.Record.State
-import Network.TLS.Parameters
+import Network.TLS.Imports
+import Network.TLS.KeySchedule
 import Network.TLS.Measurement
-import Network.TLS.Types (Role(..))
-import Network.TLS.Handshake (handshakeClient, handshakeClientWith, handshakeServer, handshakeServerWith)
+import Network.TLS.Packet
+import Network.TLS.Parameters
+import Network.TLS.PostHandshake (
+    postHandshakeAuthClientWith,
+    requestCertificateServer,
+ )
+import Network.TLS.RNG
+import Network.TLS.Record.Recv
+import Network.TLS.Record.Send
+import Network.TLS.Record.State
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types (
+    Role (..),
+    TranscriptHash (..),
+    defaultRecordSizeLimit,
+ )
 import Network.TLS.X509
-import Data.Maybe (isJust)
 
-import Crypto.Random
-
-import Control.Concurrent.MVar
-import Control.Monad.State
-import Data.IORef
-
--- deprecated imports
-import Network.Socket (Socket)
-import System.IO (Handle)
-
 class TLSParams a where
     getTLSCommonParams :: a -> CommonParams
-    getTLSRole         :: a -> Role
-    getCiphers         :: a -> [Cipher]
-    doHandshake        :: a -> Context -> IO ()
-    doHandshakeWith    :: a -> Context -> Handshake -> IO ()
+    getTLSRole :: a -> Role
+    doHandshake :: a -> Context -> IO ()
+    doHandshakeWith :: a -> Context -> HandshakeR -> IO ()
+    doRequestCertificate :: a -> Context -> IO Bool
+    doPostHandshakeAuthWith :: a -> Context -> Handshake13 -> IO ()
 
 instance TLSParams ClientParams where
-    getTLSCommonParams cparams = ( clientSupported cparams
-                                 , clientShared cparams
-                                 )
+    getTLSCommonParams cparams =
+        ( clientSupported cparams
+        , clientShared cparams
+        , clientDebug cparams
+        )
     getTLSRole _ = ClientRole
-    getCiphers cparams = supportedCiphers $ clientSupported cparams
     doHandshake = handshakeClient
     doHandshakeWith = handshakeClientWith
+    doRequestCertificate _ _ = return False
+    doPostHandshakeAuthWith = postHandshakeAuthClientWith
 
 instance TLSParams ServerParams where
-    getTLSCommonParams sparams = ( serverSupported sparams
-                                 , serverShared sparams
-                                 )
+    getTLSCommonParams sparams =
+        ( serverSupported sparams
+        , serverShared sparams
+        , serverDebug sparams
+        )
     getTLSRole _ = ServerRole
-    -- on the server we filter our allowed ciphers here according
-    -- to the credentials and DHE parameters loaded
-    getCiphers sparams = filter authorizedCKE (supportedCiphers $ serverSupported sparams)
-          where authorizedCKE cipher =
-                    case cipherKeyExchange cipher of
-                        CipherKeyExchange_RSA         -> canEncryptRSA
-                        CipherKeyExchange_DH_Anon     -> canDHE
-                        CipherKeyExchange_DHE_RSA     -> canSignRSA && canDHE
-                        CipherKeyExchange_DHE_DSS     -> canSignDSS && canDHE
-                        -- unimplemented: non ephemeral DH
-                        CipherKeyExchange_DH_DSS      -> False
-                        CipherKeyExchange_DH_RSA      -> False
-                        -- unimplemented: EC
-                        CipherKeyExchange_ECDHE_RSA   -> False
-                        CipherKeyExchange_ECDH_ECDSA  -> False
-                        CipherKeyExchange_ECDH_RSA    -> False
-                        CipherKeyExchange_ECDHE_ECDSA -> False
-
-                canDHE        = isJust $ serverDHEParams sparams
-                canSignDSS    = SignatureDSS `elem` signingAlgs
-                canSignRSA    = SignatureRSA `elem` signingAlgs
-                canEncryptRSA = isJust $ credentialsFindForDecrypting creds
-                signingAlgs   = credentialsListSigningAlgorithms creds
-                creds         = sharedCredentials $ serverShared sparams
     doHandshake = handshakeServer
     doHandshakeWith = handshakeServerWith
+    doRequestCertificate = requestCertificateServer
+    doPostHandshakeAuthWith = \_ _ _ -> return ()
 
 -- | create a new context using the backend and parameters specified.
-contextNew :: (MonadIO m, CPRG rng, HasBackend backend, TLSParams params)
-           => backend   -- ^ Backend abstraction with specific method to interact with the connection type.
-           -> params    -- ^ Parameters of the context.
-           -> rng       -- ^ Random number generator associated with this context.
-           -> m Context
-contextNew backend params rng = liftIO $ do
+contextNew
+    :: (MonadIO m, HasBackend backend, TLSParams params)
+    => backend
+    -- ^ Backend abstraction with specific method to interact with the connection type.
+    -> params
+    -- ^ Parameters of the context.
+    -> m Context
+contextNew backend params = liftIO $ do
     initializeBackend backend
 
-    let role = getTLSRole params
-        st   = newTLSState rng role
-        (supported, shared) = getTLSCommonParams params
-        ciphers = getCiphers params
+    let (supported, shared, debug) = getTLSCommonParams params
 
-    when (null ciphers) $ error "no ciphers available with those parameters"
+    seed <- case debugSeed debug of
+        Nothing -> do
+            seed <- seedNew
+            debugPrintSeed debug seed
+            return seed
+        Just determ -> return determ
+    let rng = newStateRNG seed
 
-    stvar <- newMVar st
-    eof   <- newIORef False
-    established <- newIORef False
+    let role = getTLSRole params
+        st = newTLSState rng role
+
+    tlsstate <- newMVar st
+    eof <- newIORef False
+    established <- newIORef NotEstablished
     stats <- newIORef newMeasurement
-    -- we enable the reception of SSLv2 ClientHello message only in the
-    -- server context, where we might be dealing with an old/compat client.
-    sslv2Compat <- newIORef (role == ServerRole)
     needEmptyPacket <- newIORef False
     hooks <- newIORef defaultHooks
-    tx    <- newMVar newRecordState
-    rx    <- newMVar newRecordState
-    hs    <- newMVar Nothing
-    lockWrite <- newMVar ()
-    lockRead  <- newMVar ()
-    lockState <- newMVar ()
+    tx <- newMVar newRecordState
+    rx <- newMVar newRecordState
+    hs <- newMVar Nothing
+    recvActionsRef <- newIORef []
+    sendActionRef <- newIORef Nothing
+    locks <- Locks <$> newMVar () <*> newMVar () <*> newMVar ()
+    st13ref <- newIORef defaultTLS13State
+    mylimref <- newRecordLimitRef $ Just defaultRecordSizeLimit
+    peerlimref <- newRecordLimitRef $ Just defaultRecordSizeLimit
+    hpkeref <- newIORef Nothing
+    let roleParams =
+            RoleParams
+                { doHandshake_ = doHandshake params
+                , doHandshakeWith_ = doHandshakeWith params
+                , doRequestCertificate_ = doRequestCertificate params
+                , doPostHandshakeAuthWith_ = doPostHandshakeAuthWith params
+                }
 
-    return $ Context
-            { ctxConnection   = getBackend backend
-            , ctxShared       = shared
-            , ctxSupported    = supported
-            , ctxCiphers      = ciphers
-            , ctxState        = stvar
-            , ctxTxState      = tx
-            , ctxRxState      = rx
-            , ctxHandshake    = hs
-            , ctxDoHandshake  = doHandshake params
-            , ctxDoHandshakeWith  = doHandshakeWith params
-            , ctxMeasurement  = stats
-            , ctxEOF_         = eof
-            , ctxEstablished_ = established
-            , ctxSSLv2ClientHello = sslv2Compat
-            , ctxNeedEmptyPacket  = needEmptyPacket
-            , ctxHooks            = hooks
-            , ctxLockWrite        = lockWrite
-            , ctxLockRead         = lockRead
-            , ctxLockState        = lockState
-            }
+    let ctx =
+            Context
+                { ctxBackend = getBackend backend
+                , ctxShared = shared
+                , ctxSupported = supported
+                , ctxDebug = debug
+                , ctxTLSState = tlsstate
+                , ctxMyRecordLimit = mylimref
+                , ctxPeerRecordLimit = peerlimref
+                , ctxTxRecordState = tx
+                , ctxRxRecordState = rx
+                , ctxHandshakeState = hs
+                , ctxRoleParams = roleParams
+                , ctxMeasurement = stats
+                , ctxEOF_ = eof
+                , ctxEstablished_ = established
+                , ctxNeedEmptyPacket = needEmptyPacket
+                , ctxHooks = hooks
+                , ctxLocks = locks
+                , ctxPendingRecvActions = recvActionsRef
+                , ctxPendingSendAction = sendActionRef
+                , ctxRecordLayer = recordLayer
+                , ctxHandshakeSync = HandshakeSync syncNoOp syncNoOp
+                , ctxQUICMode = False
+                , ctxTLS13State = st13ref
+                , ctxHPKE = hpkeref
+                }
 
--- | create a new context on an handle.
-contextNewOnHandle :: (MonadIO m, CPRG rng, TLSParams params)
-                   => Handle -- ^ Handle of the connection.
-                   -> params -- ^ Parameters of the context.
-                   -> rng    -- ^ Random number generator associated with this context.
-                   -> m Context
-contextNewOnHandle handle params st = contextNew handle params st
-{-# DEPRECATED contextNewOnHandle "use contextNew" #-}
+        syncNoOp _ _ = return ()
 
--- | create a new context on a socket.
-contextNewOnSocket :: (MonadIO m, CPRG rng, TLSParams params)
-                   => Socket -- ^ Socket of the connection.
-                   -> params -- ^ Parameters of the context.
-                   -> rng    -- ^ Random number generator associated with this context.
-                   -> m Context
-contextNewOnSocket sock params st = contextNew sock params st
-{-# DEPRECATED contextNewOnSocket "use contextNew" #-}
+        recordLayer =
+            RecordLayer
+                { recordEncode12 = encodeRecord12
+                , recordEncode13 = encodeRecord13
+                , recordSendBytes = sendBytes
+                , recordRecv12 = recvRecord12
+                , recordRecv13 = recvRecord13
+                }
 
+    return ctx
+
 contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO ()
 contextHookSetHandshakeRecv context f =
-    contextModifyHooks context (\hooks -> hooks { hookRecvHandshake = f })
+    contextModifyHooks context (\hooks -> hooks{hookRecvHandshake = f})
 
+contextHookSetHandshake13Recv
+    :: Context -> (Handshake13 -> IO Handshake13) -> IO ()
+contextHookSetHandshake13Recv context f =
+    contextModifyHooks context (\hooks -> hooks{hookRecvHandshake13 = f})
+
 contextHookSetCertificateRecv :: Context -> (CertificateChain -> IO ()) -> IO ()
 contextHookSetCertificateRecv context f =
-    contextModifyHooks context (\hooks -> hooks { hookRecvCertificates = f })
+    contextModifyHooks context (\hooks -> hooks{hookRecvCertificates = f})
 
 contextHookSetLogging :: Context -> Logging -> IO ()
 contextHookSetLogging context loggingCallbacks =
-    contextModifyHooks context (\hooks -> hooks { hookLogging = loggingCallbacks })
+    contextModifyHooks context (\hooks -> hooks{hookLogging = loggingCallbacks})
+
+{-# DEPRECATED getFinished "Use getTLSUnique instead" #-}
+
+-- | Getting TLS Finished sent to peer.
+getFinished :: Context -> IO (Maybe VerifyData)
+getFinished ctx = usingState_ ctx getMyVerifyData
+
+{-# DEPRECATED getPeerFinished "Use getTLSUnique instead" #-}
+
+-- | Getting TLS Finished received from peer.
+getPeerFinished :: Context -> IO (Maybe VerifyData)
+getPeerFinished ctx = usingState_ ctx getPeerVerifyData
+
+-- | Getting the "tls-unique" channel binding for TLS 1.2 (RFC5929).
+--   For TLS 1.3, 'Nothing' is returned.
+--   'supportedExtendedMainSecret' must be 'RequireEMS'
+--   But in general, it is highly recommended to upgrade to TLS 1.3
+--   and use the "tls-exporter" channel binding via 'getTLSExporter'.
+getTLSUnique :: Context -> IO (Maybe ByteString)
+getTLSUnique ctx = do
+    ver <- liftIO $ usingState_ ctx getVersion
+    if ver == TLS12
+        then do
+            mx <- usingState_ ctx getFirstVerifyData
+            case mx of
+                Nothing -> return Nothing
+                Just (VerifyData verifyData) -> return $ Just verifyData
+        else return Nothing
+
+-- | Getting the "tls-exporter" channel binding for TLS 1.3 (RFC9266).
+--   For TLS 1.2, 'Nothing' is returned.
+getTLSExporter :: Context -> IO (Maybe ByteString)
+getTLSExporter ctx = do
+    ver <- liftIO $ usingState_ ctx getVersion
+    if ver == TLS13
+        then exporter ctx "EXPORTER-Channel-Binding" "" 32
+        else return Nothing
+
+exporter :: Context -> ByteString -> ByteString -> Int -> IO (Maybe ByteString)
+exporter ctx label context outlen = do
+    msecret <- usingState_ ctx getTLS13ExporterSecret
+    mcipher <- failOnEitherError $ runRxRecordState ctx $ gets stCipher
+    return $ case (msecret, mcipher) of
+        (Just secret, Just cipher) ->
+            let h = cipherHash cipher
+                secret' = deriveSecret h secret label $ TranscriptHash ""
+                label' = "exporter"
+                value' = hash h context
+                key = hkdfExpandLabel h secret' label' value' outlen
+             in Just key
+        _ -> Nothing
+
+-- | Getting the "tls-server-end-point" channel binding for TLS 1.2
+--   (RFC5929).  For 1.3, there is no specifications for how to create
+--   it.  In this implementation, a certificate chain without
+--   extensions is hashed like TLS 1.2.
+getTLSServerEndPoint :: Context -> IO (Maybe ByteString)
+getTLSServerEndPoint ctx = do
+    mcc <- usingState_ ctx getServerCertificateChain
+    case mcc of
+        Nothing -> return Nothing
+        Just cc -> do
+            (usedHash, _, _, _) <- getRxRecordState ctx
+            return $ Just $ hash usedHash $ encodeCertificate cc
diff --git a/Network/TLS/Context/Internal.hs b/Network/TLS/Context/Internal.hs
--- a/Network/TLS/Context/Internal.hs
+++ b/Network/TLS/Context/Internal.hs
@@ -1,223 +1,531 @@
--- |
--- Module      : Network.TLS.Context.Internal
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Context.Internal
-    (
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Context.Internal (
     -- * Context configuration
-      ClientParams(..)
-    , ServerParams(..)
-    , defaultParamsClient
-    , SessionID
-    , SessionData(..)
-    , MaxFragmentEnum(..)
-    , Measurement(..)
+    ClientParams (..),
+    ServerParams (..),
+    defaultParamsClient,
+    SessionID,
+    SessionData (..),
+    MaxFragmentEnum (..),
+    Measurement (..),
 
     -- * Context object and accessor
-    , Context(..)
-    , Hooks(..)
-    , ctxEOF
-    , ctxHasSSLv2ClientHello
-    , ctxDisableSSLv2ClientHello
-    , ctxEstablished
-    , withLog
-    , ctxWithHooks
-    , contextModifyHooks
-    , setEOF
-    , setEstablished
-    , contextFlush
-    , contextClose
-    , contextSend
-    , contextRecv
-    , updateMeasure
-    , withMeasure
-    , withReadLock
-    , withWriteLock
-    , withStateLock
-    , withRWLock
+    Context (..),
+    Hooks (..),
+    Limit (..),
+    Established (..),
+    PendingRecvAction (..),
+    RecordLayer (..),
+    Locks (..),
+    RoleParams (..),
+    ctxEOF,
+    ctxEstablished,
+    withLog,
+    ctxWithHooks,
+    contextModifyHooks,
+    setEOF,
+    setEstablished,
+    contextFlush,
+    contextClose,
+    contextSend,
+    contextRecv,
+    updateRecordLayer,
+    updateMeasure,
+    withMeasure,
+    withReadLock,
+    withWriteLock,
+    withStateLock,
+    withRWLock,
 
     -- * information
-    , Information(..)
-    , contextGetInformation
+    Information (..),
+    contextGetInformation,
 
     -- * Using context states
-    , throwCore
-    , usingState
-    , usingState_
-    , runTxState
-    , runRxState
-    , usingHState
-    , getHState
-    , getStateRNG
-    ) where
+    throwCore,
+    failOnEitherError,
+    usingState,
+    usingState_,
+    runTxRecordState,
+    runRxRecordState,
+    usingHState,
+    getHState,
+    saveHState,
+    restoreHState,
+    getStateRNG,
+    tls13orLater,
+    decideRecordVersion,
 
+    -- * Misc
+    HandshakeSync (..),
+    TLS13State (..),
+    defaultTLS13State,
+    getTLS13State,
+    modifyTLS13State,
+    CipherChoice (..),
+    makeCipherChoice,
+
+    -- * RecordLimit
+    setMyRecordLimit,
+    enableMyRecordLimit,
+    getMyRecordLimit,
+    checkMyRecordLimit,
+    setPeerRecordLimit,
+    enablePeerRecordLimit,
+    getPeerRecordLimit,
+    checkPeerRecordLimit,
+    newRecordLimitRef,
+
+    -- * ECH
+    HPKEF,
+    getTLS13HPKE,
+    setTLS13HPKE,
+) where
+
+import Control.Concurrent.MVar
+import Control.Exception (throwIO)
+import Control.Monad.State.Strict
+import Data.ByteArray (convert)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
+import Data.IORef
+import Data.Tuple
+
 import Network.TLS.Backend
-import Network.TLS.Extension
 import Network.TLS.Cipher
-import Network.TLS.Struct
-import Network.TLS.Compression (Compression)
-import Network.TLS.State
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Control
 import Network.TLS.Handshake.State
 import Network.TLS.Hooks
-import Network.TLS.Record.State
-import Network.TLS.Parameters
+import Network.TLS.Imports
 import Network.TLS.Measurement
-import qualified Data.ByteString as B
+import Network.TLS.Parameters
+import Network.TLS.Record
+import Network.TLS.Record.State
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+import Network.TLS.Util
 
-import Control.Concurrent.MVar
-import Control.Monad.State
-import Control.Exception (throwIO, Exception())
-import Data.IORef
-import Data.Tuple
+-- | A TLS Context keep tls specific state, parameters and backend information.
+data Context
+    = forall a.
+      Monoid a =>
+    Context
+    { ctxBackend :: Backend
+    -- ^ return the backend object associated with this context
+    , ctxSupported :: Supported
+    , ctxShared :: Shared
+    , ctxDebug :: DebugParams
+    , ctxTLSState :: MVar TLSState
+    , ctxMeasurement :: IORef Measurement
+    , ctxEOF_ :: IORef Bool
+    -- ^ has the handle EOFed or not.
+    , ctxEstablished_ :: IORef Established
+    -- ^ has the handshake been done and been successful.
+    , ctxTxRecordState :: MVar RecordState
+    -- ^ current TX record state
+    , ctxRxRecordState :: MVar RecordState
+    -- ^ current RX record state
+    , ctxHandshakeState :: MVar (Maybe HandshakeState)
+    -- ^ optional handshake state
+    , ctxRoleParams :: RoleParams
+    -- ^ hooks for this context
+    , ctxLocks :: Locks
+    , ctxHooks :: IORef Hooks
+    , -- TLS 1.3
+      ctxTLS13State :: IORef TLS13State
+    , ctxPendingRecvActions :: IORef [PendingRecvAction]
+    , ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
+    -- ^ pending post handshake authentication requests
+    , -- QUIC
+      ctxRecordLayer :: RecordLayer a
+    , ctxHandshakeSync :: HandshakeSync
+    , ctxQUICMode :: Bool
+    , -- Misc
+      ctxNeedEmptyPacket :: IORef Bool
+    -- ^ empty packet workaround for CBC guessability.
+    , ctxMyRecordLimit :: IORef RecordLimit
+    -- ^ maximum size of plaintext fragments, val + 1 is used for TLS 1.3
+    , ctxPeerRecordLimit :: IORef RecordLimit
+    -- ^ maximum size of plaintext fragments, val + 1 is used for TLS 1.3
+    , ctxHPKE :: IORef (Maybe (HPKEF, Int))
+    }
 
+type HPKEF = ByteString -> ByteString -> IO ByteString
 
--- | Information related to a running context, e.g. current cipher
-data Information = Information
-    { infoVersion     :: Version
-    , infoCipher      :: Cipher
-    , infoCompression :: Compression
-    } deriving (Show,Eq)
+data RecordLimit
+    = NoRecordLimit -- for QUIC
+    | RecordLimit
+        Int -- effective
+        (Maybe Int) -- pending
+    deriving (Eq, Show)
 
--- | A TLS Context keep tls specific state, parameters and backend information.
-data Context = Context
-    { ctxConnection       :: Backend   -- ^ return the backend object associated with this context
-    , ctxSupported        :: Supported
-    , ctxShared           :: Shared
-    , ctxCiphers          :: [Cipher]  -- ^ prepared list of allowed ciphers according to parameters
-    , ctxState            :: MVar TLSState
-    , ctxMeasurement      :: IORef Measurement
-    , ctxEOF_             :: IORef Bool    -- ^ has the handle EOFed or not.
-    , ctxEstablished_     :: IORef Bool    -- ^ has the handshake been done and been successful.
-    , ctxNeedEmptyPacket  :: IORef Bool    -- ^ empty packet workaround for CBC guessability.
-    , ctxSSLv2ClientHello :: IORef Bool    -- ^ enable the reception of compatibility SSLv2 client hello.
-                                           -- the flag will be set to false regardless of its initial value
-                                           -- after the first packet received.
-    , ctxTxState          :: MVar RecordState -- ^ current tx state
-    , ctxRxState          :: MVar RecordState -- ^ current rx state
-    , ctxHandshake        :: MVar (Maybe HandshakeState) -- ^ optional handshake state
-    , ctxDoHandshake      :: Context -> IO ()
-    , ctxDoHandshakeWith  :: Context -> Handshake -> IO ()
-    , ctxHooks            :: IORef Hooks   -- ^ hooks for this context
-    , ctxLockWrite        :: MVar ()       -- ^ lock to use for writing data (including updating the state)
-    , ctxLockRead         :: MVar ()       -- ^ lock to use for reading data (including updating the state)
-    , ctxLockState        :: MVar ()       -- ^ lock used during read/write when receiving and sending packet.
-                                           -- it is usually nested in a write or read lock.
+data RoleParams = RoleParams
+    { doHandshake_ :: Context -> IO ()
+    , doHandshakeWith_ :: Context -> HandshakeR -> IO ()
+    , doRequestCertificate_ :: Context -> IO Bool
+    , doPostHandshakeAuthWith_ :: Context -> Handshake13 -> IO ()
     }
 
+data Locks = Locks
+    { lockWrite :: MVar ()
+    -- ^ lock to use for writing data (including updating the state)
+    , lockRead :: MVar ()
+    -- ^ lock to use for reading data (including updating the state)
+    , lockState :: MVar ()
+    -- ^ lock used during read/write when receiving and sending packet.
+    -- it is usually nested in a write or read lock.
+    }
+
+data CipherChoice = CipherChoice
+    { cVersion :: Version
+    , cCipher :: Cipher
+    , cHash :: Hash
+    , cZero :: Secret
+    }
+    deriving (Show)
+
+makeCipherChoice :: Version -> Cipher -> CipherChoice
+makeCipherChoice ver cipher = CipherChoice ver cipher h zero
+  where
+    h = cipherHash cipher
+    zero = BA.replicate (hashDigestSize h) 0
+
+data TLS13State = TLS13State
+    { tls13stRecvNST :: Bool -- client
+    , tls13stSentClientCert :: Bool -- client
+    , tls13stRecvSF :: Bool -- client
+    , tls13stSentCF :: Bool -- client
+    , tls13stRecvCF :: Bool -- server
+    , tls13stPendingRecvData :: Maybe ByteString -- client
+    , tls13stPendingSentData :: [ByteString] -> [ByteString] -- client
+    , tls13stRTT :: Millisecond
+    , tls13st0RTT :: Bool -- client
+    , tls13st0RTTAccepted :: Bool -- client
+    , tls13stClientExtensions :: [ExtensionRaw] -- client
+    , tls13stChoice :: ~CipherChoice -- client
+    , tls13stHsKey :: Maybe (SecretTriple HandshakeSecret) -- client
+    -- Actual session id for TLS 1.2, random value for TLS 1.3
+    , tls13stSession :: Session
+    , tls13stSentExtensions :: [ExtensionID]
+    }
+
+defaultTLS13State :: TLS13State
+defaultTLS13State =
+    TLS13State
+        { tls13stRecvNST = False
+        , tls13stSentClientCert = False
+        , tls13stRecvSF = False
+        , tls13stSentCF = False
+        , tls13stRecvCF = False
+        , tls13stPendingRecvData = Nothing
+        , tls13stPendingSentData = id
+        , tls13stRTT = 0
+        , tls13st0RTT = False
+        , tls13st0RTTAccepted = False
+        , tls13stClientExtensions = []
+        , tls13stChoice = undefined
+        , tls13stHsKey = Nothing
+        , tls13stSession = Session Nothing
+        , tls13stSentExtensions = []
+        }
+
+getTLS13State :: Context -> IO TLS13State
+getTLS13State Context{..} = readIORef ctxTLS13State
+
+modifyTLS13State :: Context -> (TLS13State -> TLS13State) -> IO ()
+modifyTLS13State Context{..} f = atomicModifyIORef' ctxTLS13State $ \st -> (f st, ())
+
+data HandshakeSync
+    = HandshakeSync
+        (Context -> ClientState -> IO ())
+        (Context -> ServerState -> IO ())
+
+{- FOURMOLU_DISABLE -}
+data RecordLayer a = RecordLayer
+    { -- Writing.hs
+      recordEncode12  :: Context -> Record Plaintext -> IO (Either TLSError a)
+    , recordEncode13  :: Context -> Record Plaintext -> IO (Either TLSError a)
+    , recordSendBytes :: Context -> a -> IO ()
+    , -- Reading.hs
+      recordRecv12    :: Context -> IO (Either TLSError (Record Plaintext))
+    , recordRecv13    :: Context -> IO (Either TLSError (Record Plaintext))
+    }
+{- FOURMOLU_ENABLE -}
+
+updateRecordLayer :: Monoid a => RecordLayer a -> Context -> Context
+updateRecordLayer recordLayer Context{..} =
+    Context{ctxRecordLayer = recordLayer, ..}
+
+data Established
+    = NotEstablished
+    | EarlyDataAllowed Int -- server: remaining 0-RTT bytes allowed
+    | EarlyDataNotAllowed Int -- sever: remaining 0-RTT packets allowed to skip
+    | EarlyDataSending
+    | Established
+    deriving (Eq, Show)
+
+data PendingRecvAction
+    = -- | simple pending action. The first 'Bool' is necessity of alignment.
+      PendingRecvAction Bool (Handshake13 -> IO ())
+    | PendingRecvActionSelfUpdate Bool (Handshake13R -> IO ())
+    | -- | pending action taking transcript hash up to preceding message
+      --   The first 'Bool' is necessity of alignment.
+      PendingRecvActionHash
+        Bool
+        (TranscriptHash -> Handshake13 -> IO ())
+
 updateMeasure :: Context -> (Measurement -> Measurement) -> IO ()
-updateMeasure ctx f = do
-    x <- readIORef (ctxMeasurement ctx)
-    writeIORef (ctxMeasurement ctx) $! f x
+updateMeasure ctx = modifyIORef' (ctxMeasurement ctx)
 
 withMeasure :: Context -> (Measurement -> IO a) -> IO a
 withMeasure ctx f = readIORef (ctxMeasurement ctx) >>= f
 
+-- | A shortcut for 'backendFlush . ctxBackend'.
 contextFlush :: Context -> IO ()
-contextFlush = backendFlush . ctxConnection
+contextFlush = backendFlush . ctxBackend
 
+-- | A shortcut for 'backendClose . ctxBackend'.
 contextClose :: Context -> IO ()
-contextClose = backendClose . ctxConnection
+contextClose = backendClose . ctxBackend
 
 -- | Information about the current context
 contextGetInformation :: Context -> IO (Maybe Information)
 contextGetInformation ctx = do
-    ver    <- usingState_ ctx $ gets stVersion
-    (cipher,comp) <- failOnEitherError $ runRxState ctx $ gets $ \st -> (stCipher st, stCompression st)
+    ver <- usingState_ ctx $ gets stVersion
+    hstate <- getHState ctx
+    let (ms, ems, cr, sr, hm13, grp, ech) =
+            case hstate of
+                Just st ->
+                    ( hstMainSecret st
+                    , hstExtendedMainSecret st
+                    , Just (hstClientRandom st)
+                    , hstServerRandom st
+                    , if ver == Just TLS13 then Just (hstTLS13HandshakeMode st) else Nothing
+                    , hstSupportedGroup st
+                    , hstTLS13ECHAccepted st
+                    )
+                Nothing -> (Nothing, False, Nothing, Nothing, Nothing, Nothing, False)
+    (cipher, comp) <-
+        readMVar (ctxRxRecordState ctx) <&> \st -> (stCipher st, stCompression st)
+    let accepted = case hstate of
+            Just st -> hstTLS13RTT0Status st == RTT0Accepted
+            Nothing -> False
+    tls12resumption <- usingState_ ctx getTLS12SessionResuming
     case (ver, cipher) of
-        (Just v, Just c) -> return $ Just $ Information v c comp
-        _                -> return Nothing
+        (Just v, Just c) ->
+            return $
+                Just $
+                    Information
+                        { infoVersion = v
+                        , infoCipher = c
+                        , infoCompression = comp
+                        , infoMainSecret = convert <$> ms
+                        , infoExtendedMainSecret = ems
+                        , infoClientRandom = cr
+                        , infoServerRandom = sr
+                        , infoSupportedGroup = grp
+                        , infoTLS12Resumption = tls12resumption
+                        , infoTLS13HandshakeMode = hm13
+                        , infoIsEarlyDataAccepted = accepted
+                        , infoIsECHAccepted = ech
+                        }
+        _ -> return Nothing
 
-contextSend :: Context -> Bytes -> IO ()
-contextSend c b = updateMeasure c (addBytesSent $ B.length b) >> (backendSend $ ctxConnection c) b
+contextSend :: Context -> ByteString -> IO ()
+contextSend c b =
+    updateMeasure c (addBytesSent $ B.length b) >> (backendSend $ ctxBackend c) b
 
-contextRecv :: Context -> Int -> IO Bytes
-contextRecv c sz = updateMeasure c (addBytesReceived sz) >> (backendRecv $ ctxConnection c) sz
+contextRecv :: Context -> Int -> IO ByteString
+contextRecv c sz = updateMeasure c (addBytesReceived sz) >> (backendRecv $ ctxBackend c) sz
 
 ctxEOF :: Context -> IO Bool
 ctxEOF ctx = readIORef $ ctxEOF_ ctx
 
-ctxHasSSLv2ClientHello :: Context -> IO Bool
-ctxHasSSLv2ClientHello ctx = readIORef $ ctxSSLv2ClientHello ctx
-
-ctxDisableSSLv2ClientHello :: Context -> IO ()
-ctxDisableSSLv2ClientHello ctx = writeIORef (ctxSSLv2ClientHello ctx) False
-
 setEOF :: Context -> IO ()
 setEOF ctx = writeIORef (ctxEOF_ ctx) True
 
-ctxEstablished :: Context -> IO Bool
+ctxEstablished :: Context -> IO Established
 ctxEstablished ctx = readIORef $ ctxEstablished_ ctx
 
 ctxWithHooks :: Context -> (Hooks -> IO a) -> IO a
 ctxWithHooks ctx f = readIORef (ctxHooks ctx) >>= f
 
 contextModifyHooks :: Context -> (Hooks -> Hooks) -> IO ()
-contextModifyHooks ctx f = modifyIORef (ctxHooks ctx) f
+contextModifyHooks ctx = modifyIORef' (ctxHooks ctx)
 
-setEstablished :: Context -> Bool -> IO ()
-setEstablished ctx v = writeIORef (ctxEstablished_ ctx) v
+setEstablished :: Context -> Established -> IO ()
+setEstablished ctx = writeIORef (ctxEstablished_ ctx)
 
 withLog :: Context -> (Logging -> IO ()) -> IO ()
 withLog ctx f = ctxWithHooks ctx (f . hookLogging)
 
-throwCore :: (MonadIO m, Exception e) => e -> m a
-throwCore = liftIO . throwIO
+throwCore :: MonadIO m => TLSError -> m a
+throwCore = liftIO . throwIO . Uncontextualized
 
 failOnEitherError :: MonadIO m => m (Either TLSError a) -> m a
 failOnEitherError f = do
     ret <- f
     case ret of
         Left err -> throwCore err
-        Right r  -> return r
+        Right r -> return r
 
 usingState :: Context -> TLSSt a -> IO (Either TLSError a)
 usingState ctx f =
-    modifyMVar (ctxState ctx) $ \st ->
-            let (a, newst) = runTLSState f st
-             in newst `seq` return (newst, a)
+    modifyMVar (ctxTLSState ctx) $ \st ->
+        let (a, newst) = runTLSState f st
+         in newst `seq` return (newst, a)
 
 usingState_ :: Context -> TLSSt a -> IO a
 usingState_ ctx f = failOnEitherError $ usingState ctx f
 
-usingHState :: Context -> HandshakeM a -> IO a
-usingHState ctx f = liftIO $ modifyMVar (ctxHandshake ctx) $ \mst ->
-    case mst of
-        Nothing -> throwCore $ Error_Misc "missing handshake"
-        Just st -> return $ swap (Just `fmap` runHandshake st f)
+usingHState :: MonadIO m => Context -> HandshakeM a -> m a
+usingHState ctx f = liftIO $ modifyMVar (ctxHandshakeState ctx) $ \case
+    Nothing -> liftIO $ throwIO MissingHandshake
+    Just st -> return $ swap (Just <$> runHandshake st f)
 
-getHState :: Context -> IO (Maybe HandshakeState)
-getHState ctx = liftIO $ readMVar (ctxHandshake ctx)
+getHState :: MonadIO m => Context -> m (Maybe HandshakeState)
+getHState ctx = liftIO $ readMVar (ctxHandshakeState ctx)
 
-runTxState :: Context -> RecordM a -> IO (Either TLSError a)
-runTxState ctx f = do
-    ver <- usingState_ ctx (getVersionWithDefault $ maximum $ supportedVersions $ ctxSupported ctx)
-    modifyMVar (ctxTxState ctx) $ \st ->
-        case runRecordM f ver st of
-            Left err         -> return (st, Left err)
+saveHState :: Context -> IO (Saved (Maybe HandshakeState))
+saveHState ctx = saveMVar (ctxHandshakeState ctx)
+
+restoreHState
+    :: Context
+    -> Saved (Maybe HandshakeState)
+    -> IO (Saved (Maybe HandshakeState))
+restoreHState ctx = restoreMVar (ctxHandshakeState ctx)
+
+decideRecordVersion :: Context -> IO (Version, Bool)
+decideRecordVersion ctx = usingState_ ctx $ do
+    ver <- getVersionWithDefault (maximum $ supportedVersions $ ctxSupported ctx)
+    hrr <- getTLS13HRR
+    -- For TLS 1.3, ver' is only used in ClientHello.
+    -- The record version of the first ClientHello SHOULD be TLS 1.0.
+    -- The record version of the second ClientHello MUST be TLS 1.2.
+    let ver'
+            | ver >= TLS13 = if hrr then TLS12 else TLS10
+            | otherwise = ver
+    return (ver', ver >= TLS13)
+
+runTxRecordState :: Context -> RecordM a -> IO (Either TLSError a)
+runTxRecordState ctx f = do
+    (ver, tls13) <- decideRecordVersion ctx
+    let opt =
+            RecordOptions
+                { recordVersion = ver
+                , recordTLS13 = tls13
+                }
+    modifyMVar (ctxTxRecordState ctx) $ \st ->
+        case runRecordM f opt st of
+            Left err -> return (st, Left err)
             Right (a, newSt) -> return (newSt, Right a)
 
-runRxState :: Context -> RecordM a -> IO (Either TLSError a)
-runRxState ctx f = do
-    ver <- usingState_ ctx getVersion
-    modifyMVar (ctxRxState ctx) $ \st ->
-        case runRecordM f ver st of
-            Left err         -> return (st, Left err)
+runRxRecordState :: Context -> RecordM a -> IO (Either TLSError a)
+runRxRecordState ctx f = do
+    ver <-
+        usingState_
+            ctx
+            (getVersionWithDefault $ maximum $ supportedVersions $ ctxSupported ctx)
+    -- For 1.3, ver is just ignored. So, it is not necessary to convert ver.
+    let opt =
+            RecordOptions
+                { recordVersion = ver
+                , recordTLS13 = ver >= TLS13
+                }
+    modifyMVar (ctxRxRecordState ctx) $ \st ->
+        case runRecordM f opt st of
+            Left err -> return (st, Left err)
             Right (a, newSt) -> return (newSt, Right a)
 
-getStateRNG :: Context -> Int -> IO Bytes
+getStateRNG :: Context -> Int -> IO ByteString
 getStateRNG ctx n = usingState_ ctx $ genRandom n
 
 withReadLock :: Context -> IO a -> IO a
-withReadLock ctx f = withMVar (ctxLockRead ctx) (const f)
+withReadLock ctx f = withMVar (lockRead $ ctxLocks ctx) (const f)
 
 withWriteLock :: Context -> IO a -> IO a
-withWriteLock ctx f = withMVar (ctxLockWrite ctx) (const f)
+withWriteLock ctx f = withMVar (lockWrite $ ctxLocks ctx) (const f)
 
 withRWLock :: Context -> IO a -> IO a
 withRWLock ctx f = withReadLock ctx $ withWriteLock ctx f
 
 withStateLock :: Context -> IO a -> IO a
-withStateLock ctx f = withMVar (ctxLockState ctx) (const f)
+withStateLock ctx f = withMVar (lockState $ ctxLocks ctx) (const f)
+
+tls13orLater :: MonadIO m => Context -> m Bool
+tls13orLater ctx = do
+    ev <- liftIO $ usingState ctx $ getVersionWithDefault TLS12
+    return $ case ev of
+        Left _ -> False
+        Right v -> v >= TLS13
+
+--------------------------------
+
+setMyRecordLimit :: Context -> Maybe Int -> IO ()
+setMyRecordLimit ctx msiz = modifyIORef' (ctxMyRecordLimit ctx) change
+  where
+    change (RecordLimit n _) = RecordLimit n msiz
+    change x = x
+
+enableMyRecordLimit :: Context -> IO ()
+enableMyRecordLimit ctx = modifyIORef' (ctxMyRecordLimit ctx) change
+  where
+    change (RecordLimit _ (Just n)) = RecordLimit n Nothing
+    change x = x
+
+getMyRecordLimit :: Context -> IO (Maybe Int)
+getMyRecordLimit ctx = change <$> readIORef (ctxMyRecordLimit ctx)
+  where
+    change NoRecordLimit = Nothing
+    change (RecordLimit n _) = Just n
+
+checkMyRecordLimit :: Context -> IO Bool
+checkMyRecordLimit ctx = chk <$> readIORef (ctxMyRecordLimit ctx)
+  where
+    chk NoRecordLimit = False
+    chk (RecordLimit _ mx) = isJust mx
+
+--------------------------------
+
+setPeerRecordLimit :: Context -> Maybe Int -> IO ()
+setPeerRecordLimit ctx msiz = modifyIORef' (ctxPeerRecordLimit ctx) change
+  where
+    change (RecordLimit n _) = RecordLimit n msiz
+    change x = x
+
+enablePeerRecordLimit :: Context -> IO ()
+enablePeerRecordLimit ctx = modifyIORef' (ctxPeerRecordLimit ctx) change
+  where
+    change (RecordLimit _ (Just n)) = RecordLimit n Nothing
+    change x = x
+
+getPeerRecordLimit :: Context -> IO (Maybe Int)
+getPeerRecordLimit ctx = change <$> readIORef (ctxPeerRecordLimit ctx)
+  where
+    change NoRecordLimit = Nothing
+    change (RecordLimit n _) = Just n
+
+checkPeerRecordLimit :: Context -> IO Bool
+checkPeerRecordLimit ctx = chk <$> readIORef (ctxPeerRecordLimit ctx)
+  where
+    chk NoRecordLimit = False
+    chk (RecordLimit _ mx) = isJust mx
+
+newRecordLimitRef :: Maybe Int -> IO (IORef RecordLimit)
+newRecordLimitRef Nothing = newIORef NoRecordLimit
+newRecordLimitRef (Just n) = newIORef $ RecordLimit n Nothing
+
+--------------------------------
+
+setTLS13HPKE :: Context -> HPKEF -> Int -> IO ()
+setTLS13HPKE ctx func nenc = writeIORef (ctxHPKE ctx) $ Just (func, nenc)
+
+getTLS13HPKE :: Context -> IO (Maybe (HPKEF, Int))
+getTLS13HPKE ctx = readIORef $ ctxHPKE ctx
diff --git a/Network/TLS/Core.hs b/Network/TLS/Core.hs
--- a/Network/TLS/Core.hs
+++ b/Network/TLS/Core.hs
@@ -1,123 +1,512 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_HADDOCK hide #-}
-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
--- |
--- Module      : Network.TLS.Core
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Core
-    (
+
+module Network.TLS.Core (
     -- * Internal packet sending and receiving
-      sendPacket
-    , recvPacket
+    sendPacket12,
+    recvPacket12,
 
     -- * Initialisation and Termination of context
-    , bye
-    , handshake
+    bye,
+    handshake,
 
-    -- * Next Protocol Negotiation
-    , getNegotiatedProtocol
+    -- * Application Layer Protocol Negotiation
+    getNegotiatedProtocol,
 
+    -- * Server Name Indication
+    getClientSNI,
+
     -- * High level API
-    , sendData
-    , recvData
-    , recvData'
-    ) where
+    sendData,
+    recvData,
+    recvData',
+    updateKey,
+    KeyUpdateRequest (..),
+    requestCertificate,
+) where
 
+import qualified Control.Exception as E
+import Control.Monad.State.Strict
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy as L
+import Data.IORef
+import System.Timeout
+
 import Network.TLS.Context
-import Network.TLS.Struct
-import Network.TLS.State (getSession)
-import Network.TLS.Parameters
+import Network.TLS.Extension
+import Network.TLS.Handshake
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Server
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
+import Network.TLS.Handshake.TranscriptHash
 import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.PostHandshake
 import Network.TLS.Session
-import Network.TLS.Handshake
-import Network.TLS.Util (catchException)
+import Network.TLS.State (getRole, getSession)
 import qualified Network.TLS.State as S
-import qualified Data.ByteString as B
-import Data.ByteString.Char8 ()
-import qualified Data.ByteString.Lazy as L
-import qualified Control.Exception as E
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types (
+    HostName,
+    Role (..),
+ )
+import Network.TLS.Util (catchException, mapChunks_)
 
-import Control.Monad.State
+-- | Handshake for a new TLS connection
+-- This is to be called at the beginning of a connection, and during renegotiation.
+-- Don't use this function as the acquire resource of 'bracket'.
+handshake :: MonadIO m => Context -> m ()
+handshake ctx = do
+    handshake_ ctx
+    -- Trying to receive an alert of client authentication failure
+    liftIO $ do
+        role <- usingState_ ctx getRole
+        tls13 <- tls13orLater ctx
+        sentClientCert <- tls13stSentClientCert <$> getTLS13State ctx
+        when (role == ClientRole && tls13 && sentClientCert) $ do
+            rtt <- getRTT ctx
+            -- This 'timeout' should work.
+            mdat <- timeout rtt $ recvData13 ctx
+            case mdat of
+                Nothing -> return ()
+                Just dat -> modifyTLS13State ctx $ \st -> st{tls13stPendingRecvData = Just dat}
 
+rttFactor :: Int
+rttFactor = 3
 
--- | notify the context that this side wants to close connection.
--- this is important that it is called before closing the handle, otherwise
+getRTT :: Context -> IO Int
+getRTT ctx = do
+    rtt <- tls13stRTT <$> getTLS13State ctx
+    let rtt' = max (fromIntegral rtt) 10
+    return (rtt' * rttFactor * 1000) -- ms to us
+
+-- | Notify the context that this side wants to close connection.
+-- This is important that it is called before closing the handle, otherwise
 -- the session might not be resumable (for version < TLS1.2).
+-- This doesn't actually close the handle.
 --
--- this doesn't actually close the handle
+-- Proper usage is as follows:
+--
+-- > ctx <- contextNew <backend> <params>
+-- > handshake ctx
+-- > ...
+-- > bye
+--
+-- The following code ensures nothing but is no harm.
+--
+-- > bracket (contextNew <backend> <params>) bye $ \ctx -> do
+-- >   handshake ctx
+-- >   ...
 bye :: MonadIO m => Context -> m ()
-bye ctx = sendPacket ctx $ Alert [(AlertLevel_Warning, CloseNotify)]
+bye ctx = liftIO $ do
+    eof <- ctxEOF ctx
+    tls13 <- tls13orLater ctx
+    when (tls13 && not eof) $ do
+        role <- usingState_ ctx getRole
+        if role == ClientRole
+            then do
+                withWriteLock ctx $ sendCFifNecessary ctx
+                -- receiving NewSessionTicket
+                let chk = tls13stRecvNST <$> getTLS13State ctx
+                recvNST <- chk
+                unless recvNST $ do
+                    rtt <- getRTT ctx
+                    void $ timeout rtt $ recvHS13 ctx chk
+            else do
+                -- receiving Client Finished
+                let chk = tls13stRecvCF <$> getTLS13State ctx
+                recvCF <- chk
+                unless recvCF $ do
+                    -- no chance to measure RTT before receiving CF
+                    -- fixme: 1sec is good enough?
+                    let rtt = 1000000
+                    void $ timeout rtt $ recvHS13 ctx chk
+    bye_ ctx
 
--- | If the Next Protocol Negotiation extension has been used, this will
+bye_ :: MonadIO m => Context -> m ()
+bye_ ctx = liftIO $ do
+    -- Although setEOF is always protected by the read lock, here we don't try
+    -- to wrap ctxEOF with it, so that function bye can still be called
+    -- concurrently to a blocked recvData.
+    eof <- ctxEOF ctx
+    tls13 <- tls13orLater ctx
+    unless eof $
+        withWriteLock ctx $
+            if tls13
+                then sendPacket13 ctx $ Alert13 [(AlertLevel_Warning, CloseNotify)]
+                else sendPacket12 ctx $ Alert [(AlertLevel_Warning, CloseNotify)]
+
+-- | If the ALPN extensions have been used, this will
 -- return get the protocol agreed upon.
-getNegotiatedProtocol :: MonadIO m => Context -> m (Maybe B.ByteString)
+getNegotiatedProtocol :: MonadIO m => Context -> m (Maybe ByteString)
 getNegotiatedProtocol ctx = liftIO $ usingState_ ctx S.getNegotiatedProtocol
 
+-- | If the Server Name Indication extension has been used, return the
+-- hostname specified by the client.
+getClientSNI :: MonadIO m => Context -> m (Maybe HostName)
+getClientSNI ctx = liftIO $ usingState_ ctx S.getClientSNI
+
+sendCFifNecessary :: Context -> IO ()
+sendCFifNecessary ctx = do
+    st <- getTLS13State ctx
+    let recvSF = tls13stRecvSF st
+        sentCF = tls13stSentCF st
+    when (recvSF && not sentCF) $ do
+        msend <- readIORef (ctxPendingSendAction ctx)
+        case msend of
+            Nothing -> return ()
+            Just sendAction -> do
+                sendAction ctx
+                writeIORef (ctxPendingSendAction ctx) Nothing
+
 -- | sendData sends a bunch of data.
 -- It will automatically chunk data to acceptable packet size
 sendData :: MonadIO m => Context -> L.ByteString -> m ()
-sendData ctx dataToSend = liftIO (checkValid ctx) >> mapM_ sendDataChunk (L.toChunks dataToSend)
-  where sendDataChunk d
-            | B.length d > 16384 = do
-                let (sending, remain) = B.splitAt 16384 d
-                sendPacket ctx $ AppData sending
-                sendDataChunk remain
-            | otherwise = sendPacket ctx $ AppData d
+sendData _ "" = return ()
+sendData ctx dataToSend = liftIO $ do
+    tls13 <- tls13orLater ctx
+    let sendP bs
+            | tls13 = do
+                sendPacket13 ctx $ AppData13 bs
+                role <- usingState_ ctx getRole
+                sentCF <- tls13stSentCF <$> getTLS13State ctx
+                rtt0 <- tls13st0RTT <$> getTLS13State ctx
+                when (role == ClientRole && rtt0 && not sentCF) $
+                    modifyTLS13State ctx $
+                        \st -> st{tls13stPendingSentData = tls13stPendingSentData st . (bs :)}
+            | otherwise = sendPacket12 ctx $ AppData bs
+    when tls13 $ withWriteLock ctx $ sendCFifNecessary ctx
+    withWriteLock ctx $ do
+        checkValid ctx
+        -- All chunks are protected with the same write lock because we don't
+        -- want to interleave writes from other threads in the middle of our
+        -- possibly large write.
+        mlen <- getPeerRecordLimit ctx -- plaintext, don't adjust for TLS 1.3
+        mapM_ (mapChunks_ mlen sendP) (L.toChunks dataToSend)
 
--- | recvData get data out of Data packet, and automatically renegotiate if
--- a Handshake ClientHello is received
-recvData :: MonadIO m => Context -> m B.ByteString
+-- | Get data out of Data packet, and automatically renegotiate if a Handshake
+-- ClientHello is received.  An empty result means EOF.
+recvData :: MonadIO m => Context -> m ByteString
 recvData ctx = liftIO $ do
-    checkValid ctx
-    E.catchJust safeHandleError_EOF
-                doRecv
-                (\() -> return B.empty)
-  where doRecv = do
-            pkt <- withReadLock ctx $ recvPacket ctx
-            either onError process pkt
-            
-        safeHandleError_EOF Error_EOF = Just ()
-        safeHandleError_EOF _ = Nothing
-        
-        onError err@(Error_Protocol (reason,fatal,desc)) =
-            terminate err (if fatal then AlertLevel_Fatal else AlertLevel_Warning) desc reason
-        onError err =
-            terminate err AlertLevel_Fatal InternalError (show err)
+    tls13 <- tls13orLater ctx
+    withReadLock ctx $ do
+        checkValid ctx
+        -- We protect with a read lock both reception and processing of the
+        -- packet, because don't want another thread to receive a new packet
+        -- before this one has been fully processed.
+        --
+        -- Even when recvData12/recvData13 loops, we only need to call function
+        -- checkValid once.  Since we hold the read lock, no concurrent call
+        -- will impact the validity of the context.
+        if tls13 then recvData13 ctx else recvData12 ctx
 
-        process (Handshake [ch@(ClientHello {})]) =
-            withRWLock ctx ((ctxDoHandshakeWith ctx) ctx ch) >> recvData ctx
-        process (Handshake [hr@HelloRequest]) =
-            withRWLock ctx ((ctxDoHandshakeWith ctx) ctx hr) >> recvData ctx
+recvData12 :: Context -> IO ByteString
+recvData12 ctx = do
+    pkt <- recvPacket12 ctx
+    either (onError terminate12) process pkt
+  where
+    process (Handshake [ch@ClientHello{}] [b]) =
+        handshakeWith ctx (ch, b) >> recvData12 ctx
+    process (Handshake [hr@HelloRequest] [b]) =
+        handshakeWith ctx (hr, b) >> recvData12 ctx
+    -- UserCanceled should be followed by a close_notify.
+    -- fixme: is it safe to call recvData12?
+    process (Alert [(AlertLevel_Warning, UserCanceled)]) = return B.empty
+    process (Alert [(AlertLevel_Warning, CloseNotify)]) = tryBye ctx >> setEOF ctx >> return B.empty
+    process (Alert [(AlertLevel_Fatal, desc)]) = do
+        setEOF ctx
+        E.throwIO
+            ( Terminated
+                True
+                ("received fatal error: " ++ show desc)
+                (Error_Protocol "remote side fatal error" desc)
+            )
 
-        process (Alert [(AlertLevel_Warning, CloseNotify)]) = tryBye >> setEOF ctx >> return B.empty
-        process (Alert [(AlertLevel_Fatal, desc)]) = do
-            setEOF ctx
-            E.throwIO (Terminated True ("received fatal error: " ++ show desc) (Error_Protocol ("remote side fatal error", True, desc)))
+    -- when receiving empty appdata, we just retry to get some data.
+    process (AppData "") = recvData12 ctx
+    process (AppData x) = return x
+    process p = do
+        let reason = "unexpected message " ++ show p
+        terminate12 (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
 
-        -- when receiving empty appdata, we just retry to get some data.
-        process (AppData "") = recvData ctx
-        process (AppData x)  = return x
-        process p            = let reason = "unexpected message " ++ show p in
-                               terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+    terminate12 = terminateWithWriteLock ctx (sendPacket12 ctx . Alert)
 
-        terminate :: TLSError -> AlertLevel -> AlertDescription -> String -> IO a
-        terminate err level desc reason = do
-            session <- usingState_ ctx getSession
-            case session of
-                Session Nothing    -> return ()
-                Session (Just sid) -> sessionInvalidate (sharedSessionManager $ ctxShared ctx) sid
-            catchException (sendPacket ctx $ Alert [(level, desc)]) (\_ -> return ())
-            setEOF ctx
-            E.throwIO (Terminated False reason err)
+recvData13 :: Context -> IO ByteString
+recvData13 ctx = do
+    mdat <- tls13stPendingRecvData <$> getTLS13State ctx
+    case mdat of
+        Nothing -> do
+            pkt <- recvPacket13 ctx
+            either (onError (terminate13 ctx)) process pkt
+        Just dat -> do
+            modifyTLS13State ctx $ \st -> st{tls13stPendingRecvData = Nothing}
+            return dat
+  where
+    -- UserCanceled MUST be followed by a CloseNotify.
+    process (Alert13 [(AlertLevel_Warning, UserCanceled)]) = return B.empty
+    process (Alert13 [(AlertLevel_Warning, CloseNotify)]) = tryBye ctx >> setEOF ctx >> return B.empty
+    process (Alert13 [(AlertLevel_Fatal, desc)]) = do
+        setEOF ctx
+        E.throwIO
+            ( Terminated
+                True
+                ("received fatal error: " ++ show desc)
+                (Error_Protocol "remote side fatal error" desc)
+            )
+    process (Handshake13 hs bs) = do
+        loopHandshake13 $ zip hs bs
+        recvData13 ctx
+    -- when receiving empty appdata, we just retry to get some data.
+    process (AppData13 "") = recvData13 ctx
+    process (AppData13 x) = do
+        let chunkLen = C8.length x
+        established <- ctxEstablished ctx
+        case established of
+            EarlyDataAllowed maxSize
+                | chunkLen <= maxSize -> do
+                    setEstablished ctx $ EarlyDataAllowed (maxSize - chunkLen)
+                    return x
+                | otherwise ->
+                    let reason = "early data overflow"
+                     in terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+            EarlyDataNotAllowed n
+                | n > 0 -> do
+                    setEstablished ctx $ EarlyDataNotAllowed (n - 1)
+                    recvData13 ctx -- ignore "x"
+                | otherwise -> do
+                    let reason = "early data deprotect overflow"
+                    terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+            Established -> return x
+            _ -> throwCore $ Error_Protocol "data at not-established" UnexpectedMessage
+    process ChangeCipherSpec13 = do
+        established <- ctxEstablished ctx
+        if established /= Established
+            then recvData13 ctx
+            else do
+                let reason = "CSS after Finished"
+                terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+    process p = do
+        let reason = "unexpected message " ++ show p
+        terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
 
-        -- the other side could have close the connection already, so wrap
-        -- this in a try and ignore all exceptions
-        tryBye = catchException (bye ctx) (\_ -> return ())
+    loopHandshake13 [] = return ()
+    -- fixme: some implementations send multiple NST at the same time.
+    -- Only the first one is used at this moment.
+    loopHandshake13 ((NewSessionTicket13 life add nonce (SessionIDorTicket_ ticket) exts, _b) : hbs) = do
+        role <- usingState_ ctx S.getRole
+        unless (role == ClientRole) $ do
+            let reason = "Session ticket is allowed for client only"
+            terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+        -- This part is similar to handshake code, so protected with
+        -- read+write locks (which is also what we use for all calls to the
+        -- session manager).
+        withWriteLock ctx $ do
+            Just resumptionSecret <- usingHState ctx getTLS13ResumptionSecret
+            (_, usedCipher, _, _) <- getTxRecordState ctx
+            -- mMaxSize is always Just, but anyway
+            let extract (EarlyDataIndication mMaxSize) =
+                    maybe 0 (fromIntegral . safeNonNegative32) mMaxSize
+            let choice = makeCipherChoice TLS13 usedCipher
+                psk = derivePSK choice resumptionSecret nonce
+                maxSize =
+                    lookupAndDecode
+                        EID_EarlyData
+                        MsgTNewSessionTicket
+                        exts
+                        0
+                        extract
+                life7d = min life 604800 -- 7 days max
+            tinfo <- createTLS13TicketInfo life7d (Right add) Nothing
+            sdata <- getSessionData13 ctx usedCipher tinfo maxSize psk
+            let ticket' = B.copy ticket
+            void $ sessionEstablish (sharedSessionManager $ ctxShared ctx) ticket' sdata
+            modifyTLS13State ctx $ \st -> st{tls13stRecvNST = True}
+        loopHandshake13 hbs
+    loopHandshake13 ((KeyUpdate13 mode, _b) : hbs) = do
+        let multipleKeyUpdate = any (\(h, _) -> isKeyUpdate13 h) hbs
+        when multipleKeyUpdate $ do
+            let reason = "Multiple KeyUpdate is not allowed in one record"
+            terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+        when (ctxQUICMode ctx) $ do
+            let reason = "KeyUpdate is not allowed for QUIC"
+            terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+        checkAlignment ctx
+        established <- ctxEstablished ctx
+        -- Though RFC 8446 Sec 4.6.3 does not clearly says,
+        -- unidirectional key update is legal.
+        -- So, we don't have to check if this key update is corresponding
+        -- to key update (update_requested) which we sent.
+        if established == Established
+            then do
+                keyUpdate ctx getRxRecordState setRxRecordState
+                -- Write lock wraps both actions because we don't want another
+                -- packet to be sent by another thread before the Tx state is
+                -- updated.
+                when (mode == UpdateRequested) $ withWriteLock ctx $ do
+                    sendPacket13 ctx $ Handshake13 [KeyUpdate13 UpdateNotRequested] []
+                    keyUpdate ctx getTxRecordState setTxRecordState
+                loopHandshake13 hbs
+            else do
+                let reason = "received key update before established"
+                terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+    -- Client only
+    loopHandshake13 ((h@CertRequest13{}, _b) : hbs) =
+        postHandshakeAuthWith ctx h >> loopHandshake13 hbs
+    loopHandshake13 (hb@(h, _) : hbs) = do
+        rtt0 <- tls13st0RTT <$> getTLS13State ctx
+        when rtt0 $ case h of
+            ServerHello13 SH{..} ->
+                when (isHelloRetryRequest shRandom) $ do
+                    clearTxRecordState ctx
+                    let reason = "HRR is not allowed for 0-RTT"
+                    terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+            _ -> return ()
+        cont <- popAction ctx hb
+        when cont $ loopHandshake13 hbs
 
+recvHS13 :: Context -> IO Bool -> IO ()
+recvHS13 ctx breakLoop = do
+    pkt <- recvPacket13 ctx
+    -- fixme: Left
+    either (\_ -> return ()) process pkt
+  where
+    -- UserCanceled MUST be followed by a CloseNotify.
+    process (Alert13 [(AlertLevel_Warning, CloseNotify)]) = tryBye ctx >> setEOF ctx
+    process (Alert13 [(AlertLevel_Fatal, _desc)]) = setEOF ctx
+    process (Handshake13 hs bs) = do
+        loopHandshake13 $ zip hs bs
+        stop <- breakLoop
+        unless stop $ recvHS13 ctx breakLoop
+    process _ = recvHS13 ctx breakLoop
+
+    loopHandshake13 [] = return ()
+    -- fixme: some implementations send multiple NST at the same time.
+    -- Only the first one is used at this moment.
+    loopHandshake13 ((NewSessionTicket13 life add nonce (SessionIDorTicket_ ticket) exts, _b) : hbs) = do
+        role <- usingState_ ctx S.getRole
+        unless (role == ClientRole) $ do
+            let reason = "Session ticket is allowed for client only"
+            terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+        -- This part is similar to handshake code, so protected with
+        -- read+write locks (which is also what we use for all calls to the
+        -- session manager).
+        withWriteLock ctx $ do
+            Just resumptionSecret <- usingHState ctx getTLS13ResumptionSecret
+            (_, usedCipher, _, _) <- getTxRecordState ctx
+            let choice = makeCipherChoice TLS13 usedCipher
+                psk = derivePSK choice resumptionSecret nonce
+                maxSize =
+                    lookupAndDecode
+                        EID_EarlyData
+                        MsgTNewSessionTicket
+                        exts
+                        0
+                        (\(EarlyDataIndication mms) -> fromIntegral $ safeNonNegative32 $ fromJust mms)
+                life7d = min life 604800 -- 7 days max
+            tinfo <- createTLS13TicketInfo life7d (Right add) Nothing
+            sdata <- getSessionData13 ctx usedCipher tinfo maxSize psk
+            let ticket' = B.copy ticket
+            void $ sessionEstablish (sharedSessionManager $ ctxShared ctx) ticket' sdata
+            modifyTLS13State ctx $ \st -> st{tls13stRecvNST = True}
+        loopHandshake13 hbs
+    loopHandshake13 (hb : hbs) = do
+        cont <- popAction ctx hb
+        when cont $ loopHandshake13 hbs
+
+terminate13
+    :: Context -> TLSError -> AlertLevel -> AlertDescription -> String -> IO a
+terminate13 ctx = terminateWithWriteLock ctx (sendPacket13 ctx . Alert13)
+
+popAction :: Context -> Handshake13R -> IO Bool
+popAction ctx hb@(h, _b) = do
+    mPendingRecvAction <- popPendingRecvAction ctx
+    case mPendingRecvAction of
+        Nothing -> return False
+        Just action -> do
+            -- Pending actions are executed with read+write locks, just
+            -- like regular handshake code.
+            withWriteLock ctx $
+                handleException ctx $ do
+                    case action of
+                        PendingRecvAction needAligned pa -> do
+                            when needAligned $ checkAlignment ctx
+                            updateTranscriptHash13 ctx hb
+                            pa h
+                        PendingRecvActionSelfUpdate needAligned pa -> do
+                            when needAligned $ checkAlignment ctx
+                            pa hb
+                        PendingRecvActionHash needAligned pa -> do
+                            when needAligned $ checkAlignment ctx
+                            d <- transcriptHash ctx "Pending action"
+                            updateTranscriptHash13 ctx hb
+                            pa d h
+                    -- Client: after receiving SH, app data is coming.
+                    -- this loop tries to receive it.
+                    -- App key must be installed before receiving
+                    -- the app data.
+                    sendCFifNecessary ctx
+            return True
+
+checkAlignment :: Context -> IO ()
+checkAlignment ctx = do
+    complete <- isRecvComplete ctx
+    unless complete $ do
+        let reason = "received message not aligned with record boundary"
+        terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
+
+-- the other side could have close the connection already, so wrap
+-- this in a try and ignore all exceptions
+tryBye :: Context -> IO ()
+tryBye ctx = catchException (bye_ ctx) (\_ -> return ())
+
+onError
+    :: Monad m
+    => (TLSError -> AlertLevel -> AlertDescription -> String -> m ByteString)
+    -> TLSError
+    -> m ByteString
+onError _ Error_EOF =
+    -- Not really an error.
+    return B.empty
+onError terminate err = terminate err lvl ad reason
+  where
+    (lvl, ad) = errorToAlert err
+    reason = errorToAlertMessage err
+
+terminateWithWriteLock
+    :: Context
+    -> ([(AlertLevel, AlertDescription)] -> IO ())
+    -> TLSError
+    -> AlertLevel
+    -> AlertDescription
+    -> String
+    -> IO a
+terminateWithWriteLock ctx send err level desc reason = withWriteLock ctx $ do
+    tls13 <- tls13orLater ctx
+    unless tls13 $ do
+        -- TLS 1.2 uses the same session ID and session data
+        -- for all resumed sessions.
+        --
+        -- TLS 1.3 changes session data for every resumed session.
+        session <- usingState_ ctx getSession
+        case session of
+            Session Nothing -> return ()
+            Session (Just sid) ->
+                -- calling even session ticket manager anyway
+                sessionInvalidate (sharedSessionManager $ ctxShared ctx) sid
+    catchException (send [(level, desc)]) (\_ -> return ())
+    setEOF ctx
+    debugError (ctxDebug ctx) reason
+    E.throwIO (Terminated False reason err)
+
 {-# DEPRECATED recvData' "use recvData that returns strict bytestring" #-}
+
 -- | same as recvData but returns a lazy bytestring.
 recvData' :: MonadIO m => Context -> m L.ByteString
-recvData' ctx = recvData ctx >>= return . L.fromChunks . (:[])
+recvData' ctx = L.fromChunks . (: []) <$> recvData ctx
diff --git a/Network/TLS/Credentials.hs b/Network/TLS/Credentials.hs
--- a/Network/TLS/Credentials.hs
+++ b/Network/TLS/Credentials.hs
@@ -1,106 +1,186 @@
--- |
--- Module      : Network.TLS.Credentials
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Credentials
-    ( Credential
-    , Credentials(..)
-    , credentialLoadX509
-    , credentialLoadX509FromMemory
-    , credentialsFindForSigning
-    , credentialsFindForDecrypting
-    , credentialsListSigningAlgorithms
-    ) where
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
-import Data.Monoid
-import Data.Maybe (catMaybes)
-import Data.List (find)
-import Network.TLS.Struct
-import Network.TLS.X509
+module Network.TLS.Credentials (
+    Credential,
+    Credentials (..),
+    credentialLoadX509,
+    credentialLoadX509FromMemory,
+    credentialLoadX509Chain,
+    credentialLoadX509ChainFromMemory,
+    credentialsFindForSigning,
+    credentialsFindForDecrypting,
+    credentialsListSigningAlgorithms,
+    credentialPublicPrivateKeys,
+    credentialMatchesHashSignatures,
+) where
+
+import Data.X509
+import qualified Data.X509 as X509
 import Data.X509.File
 import Data.X509.Memory
-import Data.X509
 
+import Network.TLS.Crypto
+import Network.TLS.Imports
+import qualified Network.TLS.Struct as TLS
+import Network.TLS.X509
+
 type Credential = (CertificateChain, PrivKey)
 
-newtype Credentials = Credentials [Credential]
+newtype Credentials = Credentials [Credential] deriving (Show)
 
+instance Semigroup Credentials where
+    Credentials l1 <> Credentials l2 = Credentials (l1 ++ l2)
+
 instance Monoid Credentials where
     mempty = Credentials []
+#if !(MIN_VERSION_base(4,11,0))
     mappend (Credentials l1) (Credentials l2) = Credentials (l1 ++ l2)
+#endif
 
 -- | try to create a new credential object from a public certificate
 -- and the associated private key that are stored on the filesystem
 -- in PEM format.
-credentialLoadX509 :: FilePath -- ^ public certificate (X.509 format)
-                   -> FilePath -- ^ private key associated
-                   -> IO (Either String Credential)
-credentialLoadX509 certFile privateFile = do
+credentialLoadX509
+    :: FilePath
+    -- ^ public certificate (X.509 format)
+    -> FilePath
+    -- ^ private key associated
+    -> IO (Either String Credential)
+credentialLoadX509 certFile = credentialLoadX509Chain certFile []
+
+-- | similar to 'credentialLoadX509' but take the certificate
+-- and private key from memory instead of from the filesystem.
+credentialLoadX509FromMemory
+    :: ByteString
+    -> ByteString
+    -> Either String Credential
+credentialLoadX509FromMemory certData =
+    credentialLoadX509ChainFromMemory certData []
+
+-- | similar to 'credentialLoadX509' but also allow specifying chain
+-- certificates.
+credentialLoadX509Chain
+    :: FilePath
+    -- ^ public certificate (X.509 format)
+    -> [FilePath]
+    -- ^ chain certificates (X.509 format)
+    -> FilePath
+    -- ^ private key associated
+    -> IO (Either String Credential)
+credentialLoadX509Chain certFile chainFiles privateFile = do
     x509 <- readSignedObject certFile
+    chains <- mapM readSignedObject chainFiles
     keys <- readKeyFile privateFile
     case keys of
-        []    -> return $ Left "no keys found"
-        (k:_) -> return $ Right (CertificateChain x509, k)
+        [] -> return $ Left "no keys found"
+        (k : _) -> return $ Right (CertificateChain . concat $ x509 : chains, k)
 
--- | similar to 'credentialLoadX509' but take the certificate
--- and private key from memory instead of from the filesystem.
-credentialLoadX509FromMemory :: Bytes
-                  -> Bytes
-                  -> Either String Credential
-credentialLoadX509FromMemory certData privateData = do
+-- | similar to 'credentialLoadX509FromMemory' but also allow
+-- specifying chain certificates.
+credentialLoadX509ChainFromMemory
+    :: ByteString
+    -> [ByteString]
+    -> ByteString
+    -> Either String Credential
+credentialLoadX509ChainFromMemory certData chainData privateData =
     let x509 = readSignedObjectFromMemory certData
+        chains = map readSignedObjectFromMemory chainData
         keys = readKeyFileFromMemory privateData
      in case keys of
-            []    -> Left "no keys found"
-            (k:_) -> Right (CertificateChain x509, k)
-  where
+            [] -> Left "no keys found"
+            (k : _) -> Right (CertificateChain . concat $ x509 : chains, k)
 
-credentialsListSigningAlgorithms :: Credentials -> [SignatureAlgorithm]
-credentialsListSigningAlgorithms (Credentials l) = catMaybes $ map credentialCanSign l
+credentialsListSigningAlgorithms :: Credentials -> [KeyExchangeSignatureAlg]
+credentialsListSigningAlgorithms (Credentials l) = mapMaybe credentialCanSign l
 
-credentialsFindForSigning :: SignatureAlgorithm -> Credentials -> Maybe (CertificateChain, PrivKey)
-credentialsFindForSigning sigAlg (Credentials l) = find forSigning l
-  where forSigning cred = Just sigAlg == credentialCanSign cred
+credentialsFindForSigning
+    :: KeyExchangeSignatureAlg -> Credentials -> Maybe Credential
+credentialsFindForSigning kxsAlg (Credentials l) = find forSigning l
+  where
+    forSigning cred = case credentialCanSign cred of
+        Nothing -> False
+        Just kxs -> kxs == kxsAlg
 
-credentialsFindForDecrypting :: Credentials -> Maybe (CertificateChain, PrivKey)
+credentialsFindForDecrypting :: Credentials -> Maybe Credential
 credentialsFindForDecrypting (Credentials l) = find forEncrypting l
-  where forEncrypting cred = Just () == credentialCanDecrypt cred
+  where
+    forEncrypting cred = Just () == credentialCanDecrypt cred
 
 -- here we assume that only RSA is supported for key encipherment (encryption/decryption)
 -- we keep the same construction as 'credentialCanSign', returning a Maybe of () in case
 -- this change in future.
 credentialCanDecrypt :: Credential -> Maybe ()
 credentialCanDecrypt (chain, priv) =
-    case extensionGet (certExtensions cert) of
-        Nothing    -> Just ()
-        Just (ExtKeyUsage flags)
-            | KeyUsage_keyEncipherment `elem` flags ->
-                case (pub, priv) of
-                    (PubKeyRSA _, PrivKeyRSA _) -> Just ()
-                    _                           -> Nothing
-            | otherwise                         -> Nothing
-    where cert   = signedObject $ getSigned signed
-          pub    = certPubKey cert
-          signed = getCertificateChainLeaf chain
+    case (pub, priv) of
+        (PubKeyRSA _, PrivKeyRSA _) ->
+            case extensionGet (certExtensions cert) of
+                Nothing -> Just ()
+                Just (ExtKeyUsage flags)
+                    | KeyUsage_keyEncipherment `elem` flags -> Just ()
+                    | otherwise -> Nothing
+        _ -> Nothing
+  where
+    cert = getCertificate signed
+    pub = certPubKey cert
+    signed = getCertificateChainLeaf chain
 
-credentialCanSign :: Credential -> Maybe SignatureAlgorithm
+credentialCanSign :: Credential -> Maybe KeyExchangeSignatureAlg
 credentialCanSign (chain, priv) =
     case extensionGet (certExtensions cert) of
-        Nothing    -> getSignatureAlg pub priv
+        Nothing -> findKeyExchangeSignatureAlg (pub, priv)
         Just (ExtKeyUsage flags)
-            | KeyUsage_digitalSignature `elem` flags -> getSignatureAlg pub priv
-            | otherwise                              -> Nothing
-    where cert   = signedObject $ getSigned signed
-          pub    = certPubKey cert
-          signed = getCertificateChainLeaf chain
+            | KeyUsage_digitalSignature `elem` flags ->
+                findKeyExchangeSignatureAlg (pub, priv)
+            | otherwise -> Nothing
+  where
+    cert = getCertificate signed
+    pub = certPubKey cert
+    signed = getCertificateChainLeaf chain
 
-getSignatureAlg :: PubKey -> PrivKey -> Maybe SignatureAlgorithm
-getSignatureAlg pub priv =
-    case (pub, priv) of
-        (PubKeyRSA _, PrivKeyRSA _)     -> Just SignatureRSA
-        (PubKeyDSA _, PrivKeyDSA _)     -> Just SignatureDSS
-        --(PubKeyECDSA _, PrivKeyECDSA _) -> Just SignatureECDSA
-        _                               -> Nothing
+credentialPublicPrivateKeys :: Credential -> (PubKey, PrivKey)
+credentialPublicPrivateKeys (chain, priv) = pub `seq` (pub, priv)
+  where
+    cert = getCertificate signed
+    pub = certPubKey cert
+    signed = getCertificateChainLeaf chain
+
+getHashSignature :: SignedCertificate -> Maybe TLS.HashAndSignatureAlgorithm
+getHashSignature signed =
+    case signedAlg $ getSigned signed of
+        SignatureALG hashAlg PubKeyALG_RSA -> convertHash TLS.SignatureRSA hashAlg
+        SignatureALG hashAlg PubKeyALG_DSA -> convertHash TLS.SignatureDSA hashAlg
+        SignatureALG hashAlg PubKeyALG_EC -> convertHash TLS.SignatureECDSA hashAlg
+        SignatureALG X509.HashSHA256 PubKeyALG_RSAPSS -> Just (TLS.HashIntrinsic, TLS.SignatureRSApssRSAeSHA256)
+        SignatureALG X509.HashSHA384 PubKeyALG_RSAPSS -> Just (TLS.HashIntrinsic, TLS.SignatureRSApssRSAeSHA384)
+        SignatureALG X509.HashSHA512 PubKeyALG_RSAPSS -> Just (TLS.HashIntrinsic, TLS.SignatureRSApssRSAeSHA512)
+        SignatureALG_IntrinsicHash PubKeyALG_Ed25519 -> Just (TLS.HashIntrinsic, TLS.SignatureEd25519)
+        SignatureALG_IntrinsicHash PubKeyALG_Ed448 -> Just (TLS.HashIntrinsic, TLS.SignatureEd448)
+        _ -> Nothing
+  where
+    convertHash sig X509.HashMD5 = Just (TLS.HashMD5, sig)
+    convertHash sig X509.HashSHA1 = Just (TLS.HashSHA1, sig)
+    convertHash sig X509.HashSHA224 = Just (TLS.HashSHA224, sig)
+    convertHash sig X509.HashSHA256 = Just (TLS.HashSHA256, sig)
+    convertHash sig X509.HashSHA384 = Just (TLS.HashSHA384, sig)
+    convertHash sig X509.HashSHA512 = Just (TLS.HashSHA512, sig)
+    convertHash _ _ = Nothing
+
+-- | Checks whether certificate signatures in the chain comply with a list of
+-- hash/signature algorithm pairs.  Currently the verification applies only to
+-- the signature of the leaf certificate, and when not self-signed.  This may
+-- be extended to additional chain elements in the future.
+credentialMatchesHashSignatures
+    :: [TLS.HashAndSignatureAlgorithm] -> Credential -> Bool
+credentialMatchesHashSignatures hashSigs (chain, _) =
+    case chain of
+        CertificateChain [] -> True
+        CertificateChain (leaf : _) -> isSelfSigned leaf || matchHashSig leaf
+  where
+    matchHashSig signed = case getHashSignature signed of
+        Nothing -> False
+        Just hs -> hs `elem` hashSigs
+
+    isSelfSigned signed =
+        let cert = getCertificate signed
+         in certSubjectDN cert == certIssuerDN cert
diff --git a/Network/TLS/Crypto.hs b/Network/TLS/Crypto.hs
--- a/Network/TLS/Crypto.hs
+++ b/Network/TLS/Crypto.hs
@@ -1,167 +1,502 @@
-{-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE ExistentialQuantification #-}
-module Network.TLS.Crypto
-    ( HashCtx(..)
-    , hashInit
-    , hashUpdate
-    , hashUpdateSSL
-    , hashFinal
+{-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_HADDOCK hide #-}
 
-    , module Network.TLS.Crypto.DH
+module Network.TLS.Crypto (
+    HashContext,
+    HashCtx,
+    hashInit,
+    hashUpdate,
+    hashUpdates,
+    hashUpdateSSL,
+    hashFinal,
+    module Network.TLS.Crypto.DH,
+    module Network.TLS.Crypto.IES,
+    module Network.TLS.Crypto.Types,
 
-    -- * constructor
-    , hashMD5SHA1
-    , hashSHA1
-    , hashSHA256
-    , hashSHA512
+    -- * Hash
+    hash,
+    hashChunks,
+    Hash (..),
+    hashName,
+    hashDigestSize,
+    hashBlockSize,
 
     -- * key exchange generic interface
-    , PubKey(..)
-    , PrivKey(..)
-    , PublicKey
-    , PrivateKey
-    , HashDescr(..)
-    , kxEncrypt
-    , kxDecrypt
-    , kxSign
-    , kxVerify
-    , KxError(..)
-    ) where
+    PubKey (..),
+    PrivKey (..),
+    PublicKey,
+    PrivateKey,
+    SignatureParams (..),
+    isKeyExchangeSignatureKey,
+    findKeyExchangeSignatureAlg,
+    findFiniteFieldGroup,
+    findEllipticCurveGroup,
+    kxEncrypt,
+    kxDecrypt,
+    kxSign,
+    kxVerify,
+    kxCanUseRSApkcs1,
+    kxCanUseRSApss,
+    kxSupportedPrivKeyEC,
+    KxError (..),
+    RSAEncoding (..),
+) where
 
-import qualified Crypto.Hash.SHA512 as SHA512
-import qualified Crypto.Hash.SHA256 as SHA256
-import qualified Crypto.Hash.SHA1 as SHA1
-import qualified Crypto.Hash.MD5 as MD5
-import qualified Data.ByteString as B
-import Data.ByteString (ByteString)
-import Crypto.PubKey.HashDescr
+import qualified Crypto.ECC as ECDSA
+import Crypto.Error
+import qualified Crypto.Hash as H
+import Crypto.Number.Basic (numBits)
+import qualified Crypto.PubKey.DH as DH
 import qualified Crypto.PubKey.DSA as DSA
+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA_ECC
+import qualified Crypto.PubKey.ECC.Types as ECC
+import qualified Crypto.PubKey.ECDSA as ECDSA
+import qualified Crypto.PubKey.Ed25519 as Ed25519
+import qualified Crypto.PubKey.Ed448 as Ed448
 import qualified Crypto.PubKey.RSA as RSA
 import qualified Crypto.PubKey.RSA.PKCS15 as RSA
+import qualified Crypto.PubKey.RSA.PSS as PSS
 import Crypto.Random
-import Data.X509 (PrivKey(..), PubKey(..))
+import Data.ASN1.BinaryEncoding (BER (..), DER (..))
+import Data.ASN1.Encoding
+import Data.ASN1.Types
+import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, convert)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
+import Data.Proxy
+import Data.X509 (
+    PrivKey (..),
+    PrivKeyEC (..),
+    PubKey (..),
+    PubKeyEC (..),
+    SerializedPoint (..),
+ )
+import Data.X509.EC (ecPrivKeyCurveName, ecPubKeyCurveName, unserializePoint)
+
 import Network.TLS.Crypto.DH
+import Network.TLS.Crypto.IES
+import Network.TLS.Crypto.Types
+import Network.TLS.Imports
 
-import Data.ASN1.Types
-import Data.ASN1.Encoding
-import Data.ASN1.BinaryEncoding (DER(..), BER(..))
+----------------------------------------------------------------
 
 {-# DEPRECATED PublicKey "use PubKey" #-}
 type PublicKey = PubKey
 {-# DEPRECATED PrivateKey "use PrivKey" #-}
 type PrivateKey = PrivKey
 
-data KxError =
-      RSAError RSA.Error
+data KxError
+    = RSAError RSA.Error
     | KxUnsupported
     deriving (Show)
 
-class HashCtxC a where
-    hashCName      :: a -> String
-    hashCInit      :: a -> a
-    hashCUpdate    :: a -> B.ByteString -> a
-    hashCUpdateSSL :: a -> (B.ByteString,B.ByteString) -> a
-    hashCFinal     :: a -> B.ByteString
+isKeyExchangeSignatureKey :: KeyExchangeSignatureAlg -> PubKey -> Bool
+isKeyExchangeSignatureKey = f
+  where
+    f KX_RSA (PubKeyRSA _) = True
+    f KX_DSA (PubKeyDSA _) = True
+    f KX_ECDSA (PubKeyEC _) = True
+    f KX_ECDSA (PubKeyEd25519 _) = True
+    f KX_ECDSA (PubKeyEd448 _) = True
+    f _ _ = False
 
-data HashCtx = forall h . HashCtxC h => HashCtx h
+findKeyExchangeSignatureAlg
+    :: (PubKey, PrivKey) -> Maybe KeyExchangeSignatureAlg
+findKeyExchangeSignatureAlg keyPair =
+    case keyPair of
+        (PubKeyRSA _, PrivKeyRSA _) -> Just KX_RSA
+        (PubKeyDSA _, PrivKeyDSA _) -> Just KX_DSA
+        (PubKeyEC _, PrivKeyEC _) -> Just KX_ECDSA
+        (PubKeyEd25519 _, PrivKeyEd25519 _) -> Just KX_ECDSA
+        (PubKeyEd448 _, PrivKeyEd448 _) -> Just KX_ECDSA
+        _ -> Nothing
 
-instance Show HashCtx where
-    show (HashCtx c) = hashCName c
+findFiniteFieldGroup :: DH.Params -> Maybe Group
+findFiniteFieldGroup params = lookup (pg params) table
+  where
+    pg (DH.Params p g _) = (p, g)
 
-{- MD5 & SHA1 joined -}
-data HashMD5SHA1 = HashMD5SHA1 SHA1.Ctx MD5.Ctx
+    table =
+        [ (pg prms, grp)
+        | grp <- availableFFGroups
+        , let prms = fromJust $ dhParamsForGroup grp
+        ]
 
-instance HashCtxC HashMD5SHA1 where
-    hashCName _                  = "MD5-SHA1"
-    hashCInit _                  = HashMD5SHA1 SHA1.init MD5.init
-    hashCUpdate (HashMD5SHA1 sha1ctx md5ctx) b = HashMD5SHA1 (SHA1.update sha1ctx b) (MD5.update md5ctx b)
-    hashCUpdateSSL (HashMD5SHA1 sha1ctx md5ctx) (b1,b2) = HashMD5SHA1 (SHA1.update sha1ctx b2) (MD5.update md5ctx b1)
-    hashCFinal  (HashMD5SHA1 sha1ctx md5ctx)   = B.concat [MD5.finalize md5ctx, SHA1.finalize sha1ctx]
+findEllipticCurveGroup :: PubKeyEC -> Maybe Group
+findEllipticCurveGroup ecPub =
+    case ecPubKeyCurveName ecPub of
+        Just ECC.SEC_p256r1 -> Just P256
+        Just ECC.SEC_p384r1 -> Just P384
+        Just ECC.SEC_p521r1 -> Just P521
+        _ -> Nothing
 
-newtype HashSHA1 = HashSHA1 SHA1.Ctx
+-- functions to use the hidden class.
+hashInit :: Hash -> HashContext
+hashInit MD5 = HashContext $ ContextSimple (H.hashInit :: H.Context H.MD5)
+hashInit SHA1 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA1)
+hashInit SHA224 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA224)
+hashInit SHA256 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA256)
+hashInit SHA384 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA384)
+hashInit SHA512 = HashContext $ ContextSimple (H.hashInit :: H.Context H.SHA512)
+hashInit SHA1_MD5 = HashContextSSL H.hashInit H.hashInit
 
-instance HashCtxC HashSHA1 where
-    hashCName _                  = "SHA1"
-    hashCInit _                  = HashSHA1 SHA1.init
-    hashCUpdate (HashSHA1 ctx) b = HashSHA1 (SHA1.update ctx b)
-    hashCUpdateSSL (HashSHA1 ctx) (_,b2) = HashSHA1 (SHA1.update ctx b2)
-    hashCFinal  (HashSHA1 ctx)   = SHA1.finalize ctx
+hashUpdate :: HashContext -> ByteString -> HashCtx
+hashUpdate (HashContext (ContextSimple h)) b = HashContext $ ContextSimple (H.hashUpdate h b)
+hashUpdate (HashContextSSL sha1Ctx md5Ctx) b =
+    HashContextSSL (H.hashUpdate sha1Ctx b) (H.hashUpdate md5Ctx b)
 
-newtype HashSHA256 = HashSHA256 SHA256.Ctx
+hashUpdates :: HashContext -> [ByteString] -> HashCtx
+hashUpdates (HashContext (ContextSimple h)) xs = HashContext $ ContextSimple (H.hashUpdates h xs)
+hashUpdates (HashContextSSL sha1Ctx md5Ctx) xs =
+    HashContextSSL (H.hashUpdates sha1Ctx xs) (H.hashUpdates md5Ctx xs)
 
-instance HashCtxC HashSHA256 where
-    hashCName _                    = "SHA256"
-    hashCInit _                    = HashSHA256 SHA256.init
-    hashCUpdate (HashSHA256 ctx) b = HashSHA256 (SHA256.update ctx b)
-    hashCUpdateSSL _ _             = error "CUpdateSSL with HashSHA256"
-    hashCFinal  (HashSHA256 ctx)   = SHA256.finalize ctx
+hashChunks :: Hash -> [ByteString] -> ByteString
+hashChunks h xs = hashFinal $ hashUpdates (hashInit h) xs
 
-newtype HashSHA512 = HashSHA512 SHA512.Ctx
+hashUpdateSSL
+    :: HashCtx
+    -> (ByteString, ByteString)
+    -- ^ (for the md5 context, for the sha1 context)
+    -> HashCtx
+hashUpdateSSL (HashContext _) _ = error "internal error: update SSL without a SSL Context"
+hashUpdateSSL (HashContextSSL sha1Ctx md5Ctx) (b1, b2) =
+    HashContextSSL (H.hashUpdate sha1Ctx b2) (H.hashUpdate md5Ctx b1)
 
-instance HashCtxC HashSHA512 where
-    hashCName _                    = "SHA512"
-    hashCInit _                    = HashSHA512 SHA512.init
-    hashCUpdate (HashSHA512 ctx) b = HashSHA512 (SHA512.update ctx b)
-    hashCUpdateSSL _ _             = error "CUpdateSSL with HashSHA512"
-    hashCFinal  (HashSHA512 ctx)   = SHA512.finalize ctx
+hashFinal :: HashCtx -> ByteString
+hashFinal (HashContext (ContextSimple h)) = convert $ H.hashFinalize h
+hashFinal (HashContextSSL sha1Ctx md5Ctx) =
+    B.concat [convert (H.hashFinalize md5Ctx), convert (H.hashFinalize sha1Ctx)]
 
--- functions to use the hidden class.
-hashInit :: HashCtx -> HashCtx
-hashInit   (HashCtx h)   = HashCtx $ hashCInit h
+data Hash = MD5 | SHA1 | SHA224 | SHA256 | SHA384 | SHA512 | SHA1_MD5
+    deriving (Show, Eq)
 
-hashUpdate :: HashCtx -> B.ByteString -> HashCtx
-hashUpdate (HashCtx h) b = HashCtx $ hashCUpdate h b
+data HashContext
+    = HashContext ContextSimple
+    | HashContextSSL (H.Context H.SHA1) (H.Context H.MD5)
 
-hashUpdateSSL :: HashCtx
-              -> (B.ByteString,B.ByteString) -- ^ (for the md5 context, for the sha1 context)
-              -> HashCtx
-hashUpdateSSL (HashCtx h) bs = HashCtx $ hashCUpdateSSL h bs
+instance Show HashContext where
+    show _ = "hash-context"
 
-hashFinal :: HashCtx -> B.ByteString
-hashFinal  (HashCtx h)   = hashCFinal h
+data ContextSimple
+    = forall alg. H.HashAlgorithm alg => ContextSimple (H.Context alg)
 
--- real hash constructors
-hashMD5SHA1, hashSHA1, hashSHA256, hashSHA512 :: HashCtx
-hashMD5SHA1 = HashCtx (HashMD5SHA1 SHA1.init MD5.init)
-hashSHA1    = HashCtx (HashSHA1 SHA1.init)
-hashSHA256  = HashCtx (HashSHA256 SHA256.init)
-hashSHA512  = HashCtx (HashSHA512 SHA512.init)
+type HashCtx = HashContext
 
+hash :: (ByteArray ba, ByteArrayAccess ba) => Hash -> ba -> ba
+hash MD5 b = convert (H.hash b :: H.Digest H.MD5)
+hash SHA1 b = convert (H.hash b :: H.Digest H.SHA1)
+hash SHA224 b = convert (H.hash b :: H.Digest H.SHA224)
+hash SHA256 b = convert (H.hash b :: H.Digest H.SHA256)
+hash SHA384 b = convert (H.hash b :: H.Digest H.SHA384)
+hash SHA512 b = convert (H.hash b :: H.Digest H.SHA512)
+hash SHA1_MD5 b = BA.concat [hash MD5 b, hash SHA1 b]
+
+hashName :: Hash -> String
+hashName = show
+
+-- | Digest size in bytes.
+hashDigestSize :: Hash -> Int
+hashDigestSize MD5 = 16
+hashDigestSize SHA1 = 20
+hashDigestSize SHA224 = 28
+hashDigestSize SHA256 = 32
+hashDigestSize SHA384 = 48
+hashDigestSize SHA512 = 64
+hashDigestSize SHA1_MD5 = 36
+
+hashBlockSize :: Hash -> Int
+hashBlockSize MD5 = 64
+hashBlockSize SHA1 = 64
+hashBlockSize SHA224 = 64
+hashBlockSize SHA256 = 64
+hashBlockSize SHA384 = 128
+hashBlockSize SHA512 = 128
+hashBlockSize SHA1_MD5 = 64
+
 {- key exchange methods encrypt and decrypt for each supported algorithm -}
 
-generalizeRSAWithRNG :: CPRG g => (Either RSA.Error a, g) -> (Either KxError a, g)
-generalizeRSAWithRNG (Left e, g) = (Left (RSAError e), g)
-generalizeRSAWithRNG (Right x, g) = (Right x, g)
+generalizeRSAError :: Either RSA.Error a -> Either KxError a
+generalizeRSAError (Left e) = Left (RSAError e)
+generalizeRSAError (Right x) = Right x
 
-kxEncrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either KxError ByteString, g)
-kxEncrypt g (PubKeyRSA pk) b = generalizeRSAWithRNG $ RSA.encrypt g pk b
-kxEncrypt g _              _ = (Left KxUnsupported, g)
+kxEncrypt
+    :: MonadRandom r => PublicKey -> ScrubbedBytes -> r (Either KxError ByteString)
+kxEncrypt (PubKeyRSA pk) b = generalizeRSAError <$> RSA.encrypt pk b
+kxEncrypt _ _ = return (Left KxUnsupported)
 
-kxDecrypt :: CPRG g => g -> PrivateKey -> ByteString -> (Either KxError ByteString, g)
-kxDecrypt g (PrivKeyRSA pk) b = generalizeRSAWithRNG $ RSA.decryptSafer g pk b
-kxDecrypt g _               _ = (Left KxUnsupported, g)
+kxDecrypt
+    :: MonadRandom r => PrivateKey -> ByteString -> r (Either KxError ScrubbedBytes)
+kxDecrypt (PrivKeyRSA pk) b = generalizeRSAError <$> RSA.decryptSafer pk b
+kxDecrypt _ _ = return (Left KxUnsupported)
 
+data RSAEncoding = RSApkcs1 | RSApss deriving (Show, Eq)
+
+-- | Test the RSASSA-PKCS1 length condition described in RFC 8017 section 9.2,
+-- i.e. @emLen >= tLen + 11@.  Lengths are in bytes.
+kxCanUseRSApkcs1 :: RSA.PublicKey -> Hash -> Bool
+kxCanUseRSApkcs1 pk h = RSA.public_size pk >= tLen + 11
+  where
+    tLen = prefixSize h + hashDigestSize h
+
+    prefixSize MD5 = 18
+    prefixSize SHA1 = 15
+    prefixSize SHA224 = 19
+    prefixSize SHA256 = 19
+    prefixSize SHA384 = 19
+    prefixSize SHA512 = 19
+    prefixSize _ = error (show h ++ " is not supported for RSASSA-PKCS1")
+
+-- | Test the RSASSA-PSS length condition described in RFC 8017 section 9.1.1,
+-- i.e. @emBits >= 8hLen + 8sLen + 9@.  Lengths are in bits.
+kxCanUseRSApss :: RSA.PublicKey -> Hash -> Bool
+kxCanUseRSApss pk h = numBits (RSA.public_n pk) >= 16 * hashDigestSize h + 10
+
+-- Signature algorithm and associated parameters.
+--
+-- FIXME add RSAPSSParams
+data SignatureParams
+    = RSAParams Hash RSAEncoding
+    | DSAParams
+    | ECDSAParams Hash
+    | Ed25519Params
+    | Ed448Params
+    deriving (Show, Eq)
+
 -- Verify that the signature matches the given message, using the
 -- public key.
 --
-kxVerify :: PublicKey -> HashDescr -> ByteString -> ByteString -> Bool
-kxVerify (PubKeyRSA pk) hashDescr msg sign = RSA.verify hashDescr pk msg sign
-kxVerify (PubKeyDSA pk) hashDescr msg signBS =
-    case signature of
-        Right (sig, []) -> DSA.verify (hashFunction hashDescr) pk sig msg
-        _               -> False
-  where signature = case decodeASN1' BER signBS of
-                        Left err    -> Left (show err)
-                        Right asn1s -> fromASN1 asn1s
-kxVerify _              _         _   _    = False
 
+kxVerify :: PublicKey -> SignatureParams -> ByteString -> ByteString -> Bool
+kxVerify (PubKeyRSA pk) (RSAParams alg RSApkcs1) msg sign = rsaVerifyHash alg pk msg sign
+kxVerify (PubKeyRSA pk) (RSAParams alg RSApss) msg sign = rsapssVerifyHash alg pk msg sign
+kxVerify (PubKeyDSA pk) DSAParams msg signBS =
+    case dsaToSignature signBS of
+        Just sig -> DSA.verify H.SHA1 pk sig msg
+        _ -> False
+  where
+    dsaToSignature :: ByteString -> Maybe DSA.Signature
+    dsaToSignature b =
+        case decodeASN1' BER b of
+            Left _ -> Nothing
+            Right asn1 ->
+                case asn1 of
+                    Start Sequence : IntVal r : IntVal s : End Sequence : _ ->
+                        Just DSA.Signature{DSA.sign_r = r, DSA.sign_s = s}
+                    _ ->
+                        Nothing
+kxVerify (PubKeyEC key) (ECDSAParams alg) msg sigBS =
+    fromMaybe False $
+        join $
+            withPubKeyEC key verifyProxy verifyClassic Nothing
+  where
+    decodeSignatureASN1 buildRS =
+        case decodeASN1' BER sigBS of
+            Left _ -> Nothing
+            Right [Start Sequence, IntVal r, IntVal s, End Sequence] ->
+                Just (buildRS r s)
+            Right _ -> Nothing
+    verifyProxy prx pubkey = do
+        rs <- decodeSignatureASN1 (,)
+        signature <- maybeCryptoError $ ECDSA.signatureFromIntegers prx rs
+        verifyF <- withAlg (ECDSA.verify prx)
+        return $ verifyF pubkey signature msg
+    verifyClassic pubkey = do
+        signature <- decodeSignatureASN1 ECDSA_ECC.Signature
+        verifyF <- withAlg ECDSA_ECC.verify
+        return $ verifyF pubkey signature msg
+    withAlg :: (forall hash. H.HashAlgorithm hash => hash -> a) -> Maybe a
+    withAlg f = case alg of
+        MD5 -> Just (f H.MD5)
+        SHA1 -> Just (f H.SHA1)
+        SHA224 -> Just (f H.SHA224)
+        SHA256 -> Just (f H.SHA256)
+        SHA384 -> Just (f H.SHA384)
+        SHA512 -> Just (f H.SHA512)
+        _ -> Nothing
+kxVerify (PubKeyEd25519 key) Ed25519Params msg sigBS =
+    case Ed25519.signature sigBS of
+        CryptoPassed sig -> Ed25519.verify key msg sig
+        _ -> False
+kxVerify (PubKeyEd448 key) Ed448Params msg sigBS =
+    case Ed448.signature sigBS of
+        CryptoPassed sig -> Ed448.verify key msg sig
+        _ -> False
+kxVerify _ _ _ _ = False
+
 -- Sign the given message using the private key.
 --
-kxSign :: CPRG g => g -> PrivateKey -> HashDescr -> ByteString -> (Either KxError ByteString, g)
-kxSign g (PrivKeyRSA pk) hashDescr msg =
-    generalizeRSAWithRNG $ RSA.signSafer g hashDescr pk msg
-kxSign g (PrivKeyDSA pk) hashDescr msg =
-    let (sign, g') = DSA.sign g pk (hashFunction hashDescr) msg
-     in (Right $ encodeASN1' DER $ toASN1 sign [], g')
---kxSign g _               _         _   =
---    (Left KxUnsupported, g)
+kxSign
+    :: MonadRandom r
+    => PrivateKey
+    -> PublicKey
+    -> SignatureParams
+    -> ByteString
+    -> r (Either KxError ByteString)
+kxSign (PrivKeyRSA pk) (PubKeyRSA _) (RSAParams hashAlg RSApkcs1) msg =
+    generalizeRSAError <$> rsaSignHash hashAlg pk msg
+kxSign (PrivKeyRSA pk) (PubKeyRSA _) (RSAParams hashAlg RSApss) msg =
+    generalizeRSAError <$> rsapssSignHash hashAlg pk msg
+kxSign (PrivKeyDSA pk) (PubKeyDSA _) DSAParams msg = do
+    sign <- DSA.sign pk H.SHA1 msg
+    return (Right $ encodeASN1' DER $ dsaSequence sign)
+  where
+    dsaSequence sign =
+        [ Start Sequence
+        , IntVal (DSA.sign_r sign)
+        , IntVal (DSA.sign_s sign)
+        , End Sequence
+        ]
+kxSign (PrivKeyEC pk) (PubKeyEC _) (ECDSAParams hashAlg) msg =
+    case withPrivKeyEC pk doSign (const unsupported) unsupported of
+        Nothing -> unsupported
+        Just run -> fmap encode <$> run
+  where
+    encode (r, s) =
+        encodeASN1'
+            DER
+            [Start Sequence, IntVal r, IntVal s, End Sequence]
+    doSign prx privkey = do
+        msig <- ecdsaSignHash prx hashAlg privkey msg
+        return $ case msig of
+            Nothing -> Left KxUnsupported
+            Just sign -> Right (ECDSA.signatureToIntegers prx sign)
+    unsupported = return $ Left KxUnsupported
+kxSign (PrivKeyEd25519 pk) (PubKeyEd25519 pub) Ed25519Params msg =
+    return $ Right $ convert $ Ed25519.sign pk pub msg
+kxSign (PrivKeyEd448 pk) (PubKeyEd448 pub) Ed448Params msg =
+    return $ Right $ convert $ Ed448.sign pk pub msg
+kxSign _ _ _ _ =
+    return (Left KxUnsupported)
+
+rsaSignHash
+    :: MonadRandom m
+    => Hash
+    -> RSA.PrivateKey
+    -> ByteString
+    -> m (Either RSA.Error ByteString)
+rsaSignHash SHA1_MD5 pk msg = RSA.signSafer noHash pk msg
+rsaSignHash MD5 pk msg = RSA.signSafer (Just H.MD5) pk msg
+rsaSignHash SHA1 pk msg = RSA.signSafer (Just H.SHA1) pk msg
+rsaSignHash SHA224 pk msg = RSA.signSafer (Just H.SHA224) pk msg
+rsaSignHash SHA256 pk msg = RSA.signSafer (Just H.SHA256) pk msg
+rsaSignHash SHA384 pk msg = RSA.signSafer (Just H.SHA384) pk msg
+rsaSignHash SHA512 pk msg = RSA.signSafer (Just H.SHA512) pk msg
+
+rsapssSignHash
+    :: MonadRandom m
+    => Hash
+    -> RSA.PrivateKey
+    -> ByteString
+    -> m (Either RSA.Error ByteString)
+rsapssSignHash SHA256 pk msg = PSS.signSafer (PSS.defaultPSSParams H.SHA256) pk msg
+rsapssSignHash SHA384 pk msg = PSS.signSafer (PSS.defaultPSSParams H.SHA384) pk msg
+rsapssSignHash SHA512 pk msg = PSS.signSafer (PSS.defaultPSSParams H.SHA512) pk msg
+rsapssSignHash _ _ _ = error "rsapssSignHash: unsupported hash"
+
+rsaVerifyHash :: Hash -> RSA.PublicKey -> ByteString -> ByteString -> Bool
+rsaVerifyHash SHA1_MD5 = RSA.verify noHash
+rsaVerifyHash MD5 = RSA.verify (Just H.MD5)
+rsaVerifyHash SHA1 = RSA.verify (Just H.SHA1)
+rsaVerifyHash SHA224 = RSA.verify (Just H.SHA224)
+rsaVerifyHash SHA256 = RSA.verify (Just H.SHA256)
+rsaVerifyHash SHA384 = RSA.verify (Just H.SHA384)
+rsaVerifyHash SHA512 = RSA.verify (Just H.SHA512)
+
+rsapssVerifyHash :: Hash -> RSA.PublicKey -> ByteString -> ByteString -> Bool
+rsapssVerifyHash SHA256 = PSS.verify (PSS.defaultPSSParams H.SHA256)
+rsapssVerifyHash SHA384 = PSS.verify (PSS.defaultPSSParams H.SHA384)
+rsapssVerifyHash SHA512 = PSS.verify (PSS.defaultPSSParams H.SHA512)
+rsapssVerifyHash _ = error "rsapssVerifyHash: unsupported hash"
+
+noHash :: Maybe H.MD5
+noHash = Nothing
+
+ecdsaSignHash
+    :: (MonadRandom m, ECDSA.EllipticCurveECDSA curve)
+    => proxy curve
+    -> Hash
+    -> ECDSA.Scalar curve
+    -> ByteString
+    -> m (Maybe (ECDSA.Signature curve))
+ecdsaSignHash prx SHA1 pk msg = Just <$> ECDSA.sign prx pk H.SHA1 msg
+ecdsaSignHash prx SHA224 pk msg = Just <$> ECDSA.sign prx pk H.SHA224 msg
+ecdsaSignHash prx SHA256 pk msg = Just <$> ECDSA.sign prx pk H.SHA256 msg
+ecdsaSignHash prx SHA384 pk msg = Just <$> ECDSA.sign prx pk H.SHA384 msg
+ecdsaSignHash prx SHA512 pk msg = Just <$> ECDSA.sign prx pk H.SHA512 msg
+ecdsaSignHash _ _ _ _ = return Nothing
+
+-- Currently we generate ECDSA signatures in constant time for P256 only.
+kxSupportedPrivKeyEC :: PrivKeyEC -> Bool
+kxSupportedPrivKeyEC privkey =
+    case ecPrivKeyCurveName privkey of
+        Just ECC.SEC_p256r1 -> True
+        Just ECC.SEC_p384r1 -> True
+        Just ECC.SEC_p521r1 -> True
+        _ -> False
+
+-- Perform a public-key operation with a parameterized ECC implementation when
+-- available, otherwise fallback to the classic ECC implementation.
+withPubKeyEC
+    :: PubKeyEC
+    -> ( forall curve
+          . ECDSA.EllipticCurveECDSA curve
+         => Proxy curve
+         -> ECDSA.PublicKey curve
+         -> a
+       )
+    -> (ECDSA_ECC.PublicKey -> a)
+    -> a
+    -> Maybe a
+withPubKeyEC pubkey withProxy withClassic whenUnknown =
+    case ecPubKeyCurveName pubkey of
+        Nothing -> Just whenUnknown
+        Just ECC.SEC_p256r1 ->
+            maybeCryptoError $ withProxy p256 <$> ECDSA.decodePublic p256 bs
+        Just ECC.SEC_p384r1 ->
+            maybeCryptoError $ withProxy p384 <$> ECDSA.decodePublic p384 bs
+        Just ECC.SEC_p521r1 ->
+            maybeCryptoError $ withProxy p521 <$> ECDSA.decodePublic p521 bs
+        Just curveName ->
+            let curve = ECC.getCurveByName curveName
+                pub = unserializePoint curve pt
+             in withClassic . ECDSA_ECC.PublicKey curve <$> pub
+  where
+    pt@(SerializedPoint bs) = pubkeyEC_pub pubkey
+
+-- Perform a private-key operation with a parameterized ECC implementation when
+-- available.  Calls for an unsupported curve can be prevented with
+-- kxSupportedEcPrivKey.
+withPrivKeyEC
+    :: PrivKeyEC
+    -> ( forall curve
+          . ECDSA.EllipticCurveECDSA curve
+         => Proxy curve
+         -> ECDSA.PrivateKey curve
+         -> a
+       )
+    -> (ECC.CurveName -> a)
+    -> a
+    -> Maybe a
+withPrivKeyEC privkey withProxy withUnsupported whenUnknown =
+    case ecPrivKeyCurveName privkey of
+        Nothing -> Just whenUnknown
+        Just ECC.SEC_p256r1 ->
+            -- Private key should rather be stored as bytearray and converted
+            -- using ECDSA.decodePrivate, unfortunately the data type chosen in
+            -- x509 was Integer.
+            maybeCryptoError $ withProxy p256 <$> ECDSA.scalarFromInteger p256 d
+        Just ECC.SEC_p384r1 ->
+            maybeCryptoError $ withProxy p384 <$> ECDSA.scalarFromInteger p384 d
+        Just ECC.SEC_p521r1 ->
+            maybeCryptoError $ withProxy p521 <$> ECDSA.scalarFromInteger p521 d
+        Just curveName -> Just $ withUnsupported curveName
+  where
+    d = privkeyEC_priv privkey
+
+p256 :: Proxy ECDSA.Curve_P256R1
+p256 = Proxy
+p384 :: Proxy ECDSA.Curve_P384R1
+p384 = Proxy
+p521 :: Proxy ECDSA.Curve_P521R1
+p521 = Proxy
diff --git a/Network/TLS/Crypto/DH.hs b/Network/TLS/Crypto/DH.hs
--- a/Network/TLS/Crypto/DH.hs
+++ b/Network/TLS/Crypto/DH.hs
@@ -1,31 +1,36 @@
-module Network.TLS.Crypto.DH
-    (
+module Network.TLS.Crypto.DH (
     -- * DH types
-      DHParams
-    , DHPublic
-    , DHPrivate
+    DHParams,
+    DHPublic,
+    DHPrivate,
+    DHKey,
 
     -- * DH methods
-    , dhPublic
-    , dhPrivate
-    , dhParams
-    , dhGenerateKeyPair
-    , dhGetShared
-    , dhUnwrap
-    , dhUnwrapPublic
-    ) where
+    dhPublic,
+    dhPrivate,
+    dhParams,
+    dhParamsGetP,
+    dhParamsGetG,
+    dhParamsGetBits,
+    dhGenerateKeyPair,
+    dhGetShared,
+    dhValid,
+    dhUnwrap,
+    dhUnwrapPublic,
+) where
 
-import Network.TLS.Util.Serialization (i2osp)
+import Crypto.Number.Basic (numBits)
 import qualified Crypto.PubKey.DH as DH
-import qualified Crypto.Types.PubKey.DH as DH
-import Crypto.Random (CPRG)
-import Data.ByteString (ByteString)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
 
-type DHPublic   = DH.PublicNumber
-type DHPrivate  = DH.PrivateNumber
-type DHParams   = DH.Params
-type DHKey      = ByteString
+import Network.TLS.RNG
 
+type DHPublic = DH.PublicNumber
+type DHPrivate = DH.PrivateNumber
+type DHParams = DH.Params
+type DHKey = ScrubbedBytes
+
 dhPublic :: Integer -> DHPublic
 dhPublic = DH.PublicNumber
 
@@ -33,21 +38,39 @@
 dhPrivate = DH.PrivateNumber
 
 dhParams :: Integer -> Integer -> DHParams
-dhParams = DH.Params
+dhParams p g = DH.Params p g (numBits p)
 
-dhGenerateKeyPair :: CPRG g => g -> DHParams -> ((DHPrivate, DHPublic), g)
-dhGenerateKeyPair rng params =
-    let (priv, g') = DH.generatePrivate rng params
-        pub        = DH.generatePublic params priv
-     in ((priv, pub), g')
+dhGenerateKeyPair :: MonadRandom r => DHParams -> r (DHPrivate, DHPublic)
+dhGenerateKeyPair params = do
+    priv <- DH.generatePrivate params
+    let pub = DH.calculatePublic params priv
+    return (priv, pub)
 
 dhGetShared :: DHParams -> DHPrivate -> DHPublic -> DHKey
-dhGetShared params priv pub =
-    let (DH.SharedKey sk) = DH.getShared params priv pub
-     in i2osp sk
+dhGetShared params priv pub = stripLeadingZeros sec
+  where
+    DH.SharedKey sec = DH.getShared params priv pub
+    -- strips leading zeros from the result of DH.getShared, as required
+    -- for DH(E) pre-main secret in SSL/TLS before version 1.3.
+    stripLeadingZeros sb = snd $ BA.span (== 0) sb
 
+-- Check that group element in not in the 2-element subgroup { 1, p - 1 }.
+-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1.
+-- This verification is enough when using a safe prime.
+dhValid :: DHParams -> Integer -> Bool
+dhValid (DH.Params p _ _) y = 1 < y && y < p - 1
+
 dhUnwrap :: DHParams -> DHPublic -> [Integer]
-dhUnwrap (DH.Params p g) (DH.PublicNumber y) = [p,g,y]
+dhUnwrap (DH.Params p g _) (DH.PublicNumber y) = [p, g, y]
+
+dhParamsGetP :: DHParams -> Integer
+dhParamsGetP (DH.Params p _ _) = p
+
+dhParamsGetG :: DHParams -> Integer
+dhParamsGetG (DH.Params _ g _) = g
+
+dhParamsGetBits :: DHParams -> Int
+dhParamsGetBits (DH.Params _ _ b) = b
 
 dhUnwrapPublic :: DHPublic -> Integer
 dhUnwrapPublic (DH.PublicNumber y) = y
diff --git a/Network/TLS/Crypto/IES.hs b/Network/TLS/Crypto/IES.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Crypto/IES.hs
@@ -0,0 +1,525 @@
+-- | (Elliptic Curve) Integrated Encryption Scheme
+--   KEM(Key Encapsulation Mechanism) based APIs
+--
+-- Module      : Network.TLS.Crypto.IES
+-- License     : BSD-style
+-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>
+-- Stability   : experimental
+-- Portability : unknown
+module Network.TLS.Crypto.IES (
+    GroupPublicA,
+    GroupPublicB,
+    GroupPrivate,
+    GroupKey,
+
+    -- * Group methods
+    groupGenerateKeyPair,
+    groupEncapsulate,
+    groupDecapsulate,
+    groupEncodePublicA,
+    groupDecodePublicA,
+    groupEncodePublicB,
+    groupDecodePublicB,
+
+    -- * Compatibility with 'Network.TLS.Crypto.DH'
+    dhParamsForGroup,
+    dhGroupGenerateKeyPair,
+    dhGroupGetPubShared,
+) where
+
+import Control.Arrow
+import Crypto.ECC as ECC
+import Crypto.Error
+import Crypto.Number.Generate
+import Crypto.PubKey.DH (PrivateNumber (..), PublicNumber (..))
+import qualified Crypto.PubKey.DH as DH
+import Crypto.PubKey.ECIES
+import Crypto.PubKey.ML_KEM (ML_KEM_1024, ML_KEM_512, ML_KEM_768)
+import qualified Crypto.PubKey.ML_KEM as ML
+import Data.ByteArray (ScrubbedBytes, convert)
+import qualified Data.ByteArray as BA
+import Data.Proxy
+
+import Network.TLS.Crypto.Types
+import Network.TLS.Extra.FFDHE
+import Network.TLS.Imports
+import Network.TLS.RNG
+import Network.TLS.Util.Serialization (i2ospOf_, os2ip)
+
+{- FOURMOLU_DISABLE -}
+data GroupPrivate
+    = GroupPri_P256 (Scalar Curve_P256R1)
+    | GroupPri_P384 (Scalar Curve_P384R1)
+    | GroupPri_P521 (Scalar Curve_P521R1)
+    | GroupPri_X255 (Scalar Curve_X25519)
+    | GroupPri_X448 (Scalar Curve_X448)
+    | GroupPri_FFDHE2048 PrivateNumber
+    | GroupPri_FFDHE3072 PrivateNumber
+    | GroupPri_FFDHE4096 PrivateNumber
+    | GroupPri_FFDHE6144 PrivateNumber
+    | GroupPri_FFDHE8192 PrivateNumber
+    | GroupPri_MLKEM512       (ML.DecapsulationKey ML_KEM_512)
+    | GroupPri_MLKEM768       (ML.DecapsulationKey ML_KEM_768)
+    | GroupPri_MLKEM1024      (ML.DecapsulationKey ML_KEM_1024)
+    | GroupPri_X25519MLKEM768 (Scalar Curve_X25519, ML.DecapsulationKey ML_KEM_768)
+    | GroupPri_P256MLKEM768   (Scalar Curve_P256R1, ML.DecapsulationKey ML_KEM_768)
+    | GroupPri_P384MLKEM1024  (Scalar Curve_P384R1, ML.DecapsulationKey ML_KEM_1024)
+    deriving (Eq, Show)
+{- FOURMOLU_ENABLE -}
+
+{- FOURMOLU_DISABLE -}
+data GroupPublicA
+    = GroupPubA_P256 (Point Curve_P256R1)
+    | GroupPubA_P384 (Point Curve_P384R1)
+    | GroupPubA_P521 (Point Curve_P521R1)
+    | GroupPubA_X255 (Point Curve_X25519)
+    | GroupPubA_X448 (Point Curve_X448)
+    | GroupPubA_FFDHE2048 PublicNumber
+    | GroupPubA_FFDHE3072 PublicNumber
+    | GroupPubA_FFDHE4096 PublicNumber
+    | GroupPubA_FFDHE6144 PublicNumber
+    | GroupPubA_FFDHE8192 PublicNumber
+    | GroupPubA_MLKEM512       (ML.EncapsulationKey ML_KEM_512)
+    | GroupPubA_MLKEM768       (ML.EncapsulationKey ML_KEM_768)
+    | GroupPubA_MLKEM1024      (ML.EncapsulationKey ML_KEM_1024)
+    | GroupPubA_X25519MLKEM768 (Point Curve_X25519, ML.EncapsulationKey ML_KEM_768)
+    | GroupPubA_P256MLKEM768   (Point Curve_P256R1, ML.EncapsulationKey ML_KEM_768)
+    | GroupPubA_P384MLKEM1024  (Point Curve_P384R1, ML.EncapsulationKey ML_KEM_1024)
+    deriving (Eq, Show)
+{- FOURMOLU_ENABLE -}
+
+{- FOURMOLU_DISABLE -}
+data GroupPublicB
+    = GroupPubB_P256 (Point Curve_P256R1)
+    | GroupPubB_P384 (Point Curve_P384R1)
+    | GroupPubB_P521 (Point Curve_P521R1)
+    | GroupPubB_X255 (Point Curve_X25519)
+    | GroupPubB_X448 (Point Curve_X448)
+    | GroupPubB_FFDHE2048 PublicNumber
+    | GroupPubB_FFDHE3072 PublicNumber
+    | GroupPubB_FFDHE4096 PublicNumber
+    | GroupPubB_FFDHE6144 PublicNumber
+    | GroupPubB_FFDHE8192 PublicNumber
+    | GroupPubB_MLKEM512       (ML.Ciphertext ML_KEM_512)
+    | GroupPubB_MLKEM768       (ML.Ciphertext ML_KEM_768)
+    | GroupPubB_MLKEM1024      (ML.Ciphertext ML_KEM_1024)
+    | GroupPubB_X25519MLKEM768 (Point Curve_X25519, ML.Ciphertext ML_KEM_768)
+    | GroupPubB_P256MLKEM768   (Point Curve_P256R1, ML.Ciphertext ML_KEM_768)
+    | GroupPubB_P384MLKEM1024  (Point Curve_P384R1, ML.Ciphertext ML_KEM_1024)
+    deriving (Eq, Show)
+{- FOURMOLU_ENABLE -}
+
+type GroupKey = ScrubbedBytes
+
+p256 :: Proxy Curve_P256R1
+p256 = Proxy
+
+p384 :: Proxy Curve_P384R1
+p384 = Proxy
+
+p521 :: Proxy Curve_P521R1
+p521 = Proxy
+
+x25519 :: Proxy Curve_X25519
+x25519 = Proxy
+
+x448 :: Proxy Curve_X448
+x448 = Proxy
+
+mlkem512 :: Proxy ML_KEM_512
+mlkem512 = Proxy
+
+mlkem768 :: Proxy ML_KEM_768
+mlkem768 = Proxy
+
+mlkem1024 :: Proxy ML_KEM_1024
+mlkem1024 = Proxy
+
+dhParamsForGroup :: Group -> Maybe DH.Params
+dhParamsForGroup FFDHE2048 = Just ffdhe2048
+dhParamsForGroup FFDHE3072 = Just ffdhe3072
+dhParamsForGroup FFDHE4096 = Just ffdhe4096
+dhParamsForGroup FFDHE6144 = Just ffdhe6144
+dhParamsForGroup FFDHE8192 = Just ffdhe8192
+dhParamsForGroup _ = Nothing
+
+groupGenerateKeyPair :: MonadRandom r => Group -> r (GroupPrivate, GroupPublicA)
+groupGenerateKeyPair P256 =
+    (GroupPri_P256, GroupPubA_P256) `fs` curveGenerateKeyPair p256
+groupGenerateKeyPair P384 =
+    (GroupPri_P384, GroupPubA_P384) `fs` curveGenerateKeyPair p384
+groupGenerateKeyPair P521 =
+    (GroupPri_P521, GroupPubA_P521) `fs` curveGenerateKeyPair p521
+groupGenerateKeyPair X25519 =
+    (GroupPri_X255, GroupPubA_X255) `fs` curveGenerateKeyPair x25519
+groupGenerateKeyPair X448 =
+    (GroupPri_X448, GroupPubA_X448) `fs` curveGenerateKeyPair x448
+groupGenerateKeyPair FFDHE2048 = gen ffdhe2048 exp2048 GroupPri_FFDHE2048 GroupPubA_FFDHE2048
+groupGenerateKeyPair FFDHE3072 = gen ffdhe3072 exp3072 GroupPri_FFDHE3072 GroupPubA_FFDHE3072
+groupGenerateKeyPair FFDHE4096 = gen ffdhe4096 exp4096 GroupPri_FFDHE4096 GroupPubA_FFDHE4096
+groupGenerateKeyPair FFDHE6144 = gen ffdhe6144 exp6144 GroupPri_FFDHE6144 GroupPubA_FFDHE6144
+groupGenerateKeyPair FFDHE8192 = gen ffdhe8192 exp8192 GroupPri_FFDHE8192 GroupPubA_FFDHE8192
+groupGenerateKeyPair MLKEM512 = do
+    (e, d) <- ML.generate mlkem512
+    return (GroupPri_MLKEM512 d, GroupPubA_MLKEM512 e)
+groupGenerateKeyPair MLKEM768 = do
+    (e, d) <- ML.generate mlkem768
+    return (GroupPri_MLKEM768 d, GroupPubA_MLKEM768 e)
+groupGenerateKeyPair MLKEM1024 = do
+    (e, d) <- ML.generate mlkem1024
+    return (GroupPri_MLKEM1024 d, GroupPubA_MLKEM1024 e)
+groupGenerateKeyPair X25519MLKEM768 = do
+    (d1, e1) <- fs' $ curveGenerateKeyPair x25519
+    (e2, d2) <- ML.generate mlkem768
+    return (GroupPri_X25519MLKEM768 (d1, d2), GroupPubA_X25519MLKEM768 (e1, e2))
+groupGenerateKeyPair P256MLKEM768 = do
+    (d1, e1) <- fs' $ curveGenerateKeyPair p256
+    (e2, d2) <- ML.generate mlkem768
+    return (GroupPri_P256MLKEM768 (d1, d2), GroupPubA_P256MLKEM768 (e1, e2))
+groupGenerateKeyPair P384MLKEM1024 = do
+    (d1, e1) <- fs' $ curveGenerateKeyPair p384
+    (e2, d2) <- ML.generate mlkem1024
+    return (GroupPri_P384MLKEM1024 (d1, d2), GroupPubA_P384MLKEM1024 (e1, e2))
+groupGenerateKeyPair _ = error "groupGenerateKeyPair"
+
+dhGroupGenerateKeyPair
+    :: MonadRandom r => Group -> r (DH.Params, PrivateNumber, PublicNumber)
+dhGroupGenerateKeyPair FFDHE2048 = addParams ffdhe2048 (gen' ffdhe2048 exp2048)
+dhGroupGenerateKeyPair FFDHE3072 = addParams ffdhe3072 (gen' ffdhe3072 exp3072)
+dhGroupGenerateKeyPair FFDHE4096 = addParams ffdhe4096 (gen' ffdhe4096 exp4096)
+dhGroupGenerateKeyPair FFDHE6144 = addParams ffdhe6144 (gen' ffdhe6144 exp6144)
+dhGroupGenerateKeyPair FFDHE8192 = addParams ffdhe8192 (gen' ffdhe8192 exp8192)
+dhGroupGenerateKeyPair grp = error ("invalid FFDHE group: " ++ show grp)
+
+addParams :: Functor f => DH.Params -> f (a, b) -> f (DH.Params, a, b)
+addParams params = fmap $ \(a, b) -> (params, a, b)
+
+fs
+    :: MonadRandom r
+    => (Scalar a -> GroupPrivate, Point a -> GroupPublicA)
+    -> r (KeyPair a)
+    -> r (GroupPrivate, GroupPublicA)
+(t1, t2) `fs` action = do
+    keypair <- action
+    let pub = keypairGetPublic keypair
+        pri = keypairGetPrivate keypair
+    return (t1 pri, t2 pub)
+
+fs' :: Monad m => m (KeyPair curve) -> m (Scalar curve, Point curve)
+fs' action = do
+    keypair <- action
+    let pub = keypairGetPublic keypair
+        pri = keypairGetPrivate keypair
+    return (pri, pub)
+
+gen
+    :: MonadRandom r
+    => DH.Params
+    -> Int
+    -> (PrivateNumber -> GroupPrivate)
+    -> (PublicNumber -> GroupPublicA)
+    -> r (GroupPrivate, GroupPublicA)
+gen params expBits priTag pubTag = (priTag *** pubTag) <$> gen' params expBits
+
+gen'
+    :: MonadRandom r
+    => DH.Params
+    -> Int
+    -> r (PrivateNumber, PublicNumber)
+gen' params expBits = (id &&& DH.calculatePublic params) <$> generatePriv expBits
+
+groupEncapsulate
+    :: MonadRandom r => GroupPublicA -> r (Maybe (GroupPublicB, GroupKey))
+groupEncapsulate (GroupPubA_P256 pub) = getECDHPubShared GroupPubB_P256 p256 pub
+groupEncapsulate (GroupPubA_P384 pub) = getECDHPubShared GroupPubB_P384 p384 pub
+groupEncapsulate (GroupPubA_P521 pub) = getECDHPubShared GroupPubB_P521 p521 pub
+groupEncapsulate (GroupPubA_X255 pub) = getECDHPubShared GroupPubB_X255 x25519 pub
+groupEncapsulate (GroupPubA_X448 pub) = getECDHPubShared GroupPubB_X448 x448 pub
+groupEncapsulate (GroupPubA_FFDHE2048 pub) = getDHPubShared ffdhe2048 exp2048 pub GroupPubB_FFDHE2048
+groupEncapsulate (GroupPubA_FFDHE3072 pub) = getDHPubShared ffdhe3072 exp3072 pub GroupPubB_FFDHE3072
+groupEncapsulate (GroupPubA_FFDHE4096 pub) = getDHPubShared ffdhe4096 exp4096 pub GroupPubB_FFDHE4096
+groupEncapsulate (GroupPubA_FFDHE6144 pub) = getDHPubShared ffdhe6144 exp6144 pub GroupPubB_FFDHE6144
+groupEncapsulate (GroupPubA_FFDHE8192 pub) = getDHPubShared ffdhe8192 exp8192 pub GroupPubB_FFDHE8192
+groupEncapsulate (GroupPubA_MLKEM512 pub) = do
+    (sec, ct) <- ML.encapsulate pub
+    return $ Just (GroupPubB_MLKEM512 ct, convert sec)
+groupEncapsulate (GroupPubA_MLKEM768 pub) = do
+    (sec, ct) <- ML.encapsulate pub
+    return $ Just (GroupPubB_MLKEM768 ct, convert sec)
+groupEncapsulate (GroupPubA_MLKEM1024 pub) = do
+    (sec, ct) <- ML.encapsulate pub
+    return $ Just (GroupPubB_MLKEM1024 ct, convert sec)
+groupEncapsulate (GroupPubA_X25519MLKEM768 (e1, e2)) = do
+    (c1, k1) <- fromJust <$> getECDHPubShared' x25519 e1
+    (k2, c2) <- ML.encapsulate e2
+    -- Sec 4.1: Specifically, the order of shares in the concatenation
+    -- has been reversed.
+    return $ Just (GroupPubB_X25519MLKEM768 (c1, c2), convert k2 <> k1)
+groupEncapsulate (GroupPubA_P256MLKEM768 (e1, e2)) = do
+    (c1, k1) <- fromJust <$> getECDHPubShared' p256 e1
+    (k2, c2) <- ML.encapsulate e2
+    return $ Just (GroupPubB_P256MLKEM768 (c1, c2), k1 <> convert k2)
+groupEncapsulate (GroupPubA_P384MLKEM1024 (e1, e2)) = do
+    (c1, k1) <- fromJust <$> getECDHPubShared' p384 e1
+    (k2, c2) <- ML.encapsulate e2
+    return $ Just (GroupPubB_P384MLKEM1024 (c1, c2), k1 <> convert k2)
+
+dhGroupGetPubShared
+    :: MonadRandom r => Group -> PublicNumber -> r (Maybe (PublicNumber, GroupKey))
+dhGroupGetPubShared FFDHE2048 pub = getDHPubShared' ffdhe2048 exp2048 pub
+dhGroupGetPubShared FFDHE3072 pub = getDHPubShared' ffdhe3072 exp3072 pub
+dhGroupGetPubShared FFDHE4096 pub = getDHPubShared' ffdhe4096 exp4096 pub
+dhGroupGetPubShared FFDHE6144 pub = getDHPubShared' ffdhe6144 exp6144 pub
+dhGroupGetPubShared FFDHE8192 pub = getDHPubShared' ffdhe8192 exp8192 pub
+dhGroupGetPubShared _ _ = return Nothing
+
+getECDHPubShared
+    :: (MonadRandom m, EllipticCurveDH curve)
+    => (Point curve -> GroupPublicB)
+    -> proxy curve
+    -> Point curve
+    -> m (Maybe (GroupPublicB, GroupKey))
+getECDHPubShared tag proxy pub = do
+    mx <- maybeCryptoError <$> deriveEncrypt proxy pub
+    case mx of
+        Nothing -> return Nothing
+        Just (p, ECC.SharedSecret s) -> return $ Just (tag p, s)
+
+getECDHPubShared'
+    :: (MonadRandom m, EllipticCurveDH curve)
+    => proxy curve
+    -> Point curve
+    -> m (Maybe (Point curve, GroupKey))
+getECDHPubShared' proxy pub = do
+    mx <- maybeCryptoError <$> deriveEncrypt proxy pub
+    case mx of
+        Nothing -> return Nothing
+        Just (p, ECC.SharedSecret s) -> return $ Just (p, s)
+
+getDHPubShared
+    :: MonadRandom r
+    => DH.Params
+    -> Int
+    -> PublicNumber
+    -> (PublicNumber -> GroupPublicB)
+    -> r (Maybe (GroupPublicB, GroupKey))
+getDHPubShared params expBits pub pubTag
+    | not (valid params pub) = return Nothing
+    | otherwise = do
+        mypri <- generatePriv expBits
+        let mypub = DH.calculatePublic params mypri
+            DH.SharedKey share = DH.getShared params mypri pub
+        return $ Just (pubTag mypub, share)
+
+getDHPubShared'
+    :: MonadRandom r
+    => DH.Params
+    -> Int
+    -> PublicNumber
+    -> r (Maybe (PublicNumber, GroupKey))
+getDHPubShared' params expBits pub
+    | not (valid params pub) = return Nothing
+    | otherwise = do
+        mypri <- generatePriv expBits
+        let share = stripLeadingZeros (DH.getShared params mypri pub)
+        return $ Just (DH.calculatePublic params mypri, convert share)
+
+unwrap :: SharedSecret -> GroupKey
+unwrap (ECC.SharedSecret sec) = sec
+
+groupDecapsulate :: GroupPublicB -> GroupPrivate -> Maybe GroupKey
+groupDecapsulate (GroupPubB_P256 pub) (GroupPri_P256 pri) = (unwrap <$>) . maybeCryptoError $ deriveDecrypt p256 pub pri
+groupDecapsulate (GroupPubB_P384 pub) (GroupPri_P384 pri) = (unwrap <$>) . maybeCryptoError $ deriveDecrypt p384 pub pri
+groupDecapsulate (GroupPubB_P521 pub) (GroupPri_P521 pri) = (unwrap <$>) . maybeCryptoError $ deriveDecrypt p521 pub pri
+groupDecapsulate (GroupPubB_X255 pub) (GroupPri_X255 pri) = (unwrap <$>) . maybeCryptoError $ deriveDecrypt x25519 pub pri
+groupDecapsulate (GroupPubB_X448 pub) (GroupPri_X448 pri) = (unwrap <$>) . maybeCryptoError $ deriveDecrypt x448 pub pri
+groupDecapsulate (GroupPubB_FFDHE2048 pub) (GroupPri_FFDHE2048 pri) = calcDHShared ffdhe2048 pub pri
+groupDecapsulate (GroupPubB_FFDHE3072 pub) (GroupPri_FFDHE3072 pri) = calcDHShared ffdhe3072 pub pri
+groupDecapsulate (GroupPubB_FFDHE4096 pub) (GroupPri_FFDHE4096 pri) = calcDHShared ffdhe4096 pub pri
+groupDecapsulate (GroupPubB_FFDHE6144 pub) (GroupPri_FFDHE6144 pri) = calcDHShared ffdhe6144 pub pri
+groupDecapsulate (GroupPubB_FFDHE8192 pub) (GroupPri_FFDHE8192 pri) = calcDHShared ffdhe8192 pub pri
+groupDecapsulate (GroupPubB_MLKEM512 p) (GroupPri_MLKEM512 s) =
+    Just $ convert $ ML.decapsulate s p
+groupDecapsulate (GroupPubB_MLKEM768 p) (GroupPri_MLKEM768 s) =
+    Just $ convert $ ML.decapsulate s p
+groupDecapsulate (GroupPubB_MLKEM1024 p) (GroupPri_MLKEM1024 s) =
+    Just $ convert $ ML.decapsulate s p
+groupDecapsulate (GroupPubB_X25519MLKEM768 (p1, p2)) (GroupPri_X25519MLKEM768 (s1, s2)) = do
+    bs1 <- (unwrap <$>) . maybeCryptoError $ deriveDecrypt x25519 p1 s1
+    let bs2 = convert $ ML.decapsulate s2 p2
+    return (bs2 <> bs1)
+groupDecapsulate (GroupPubB_P256MLKEM768 (p1, p2)) (GroupPri_P256MLKEM768 (s1, s2)) = do
+    bs1 <- (unwrap <$>) . maybeCryptoError $ deriveDecrypt p256 p1 s1
+    let bs2 = convert $ ML.decapsulate s2 p2
+    return (bs1 <> bs2)
+groupDecapsulate (GroupPubB_P384MLKEM1024 (p1, p2)) (GroupPri_P384MLKEM1024 (s1, s2)) = do
+    bs1 <- (unwrap <$>) . maybeCryptoError $ deriveDecrypt p384 p1 s1
+    let bs2 = convert $ ML.decapsulate s2 p2
+    return (bs1 <> bs2)
+groupDecapsulate _ _ = Nothing
+
+calcDHShared :: DH.Params -> PublicNumber -> PrivateNumber -> Maybe GroupKey
+calcDHShared params pub pri
+    | valid params pub = Just $ convert share
+    | otherwise = Nothing
+  where
+    share = DH.getShared params pri pub
+
+groupEncodePublicA :: GroupPublicA -> ByteString
+groupEncodePublicA (GroupPubA_P256 p) = encodePoint p256 p
+groupEncodePublicA (GroupPubA_P384 p) = encodePoint p384 p
+groupEncodePublicA (GroupPubA_P521 p) = encodePoint p521 p
+groupEncodePublicA (GroupPubA_X255 p) = encodePoint x25519 p
+groupEncodePublicA (GroupPubA_X448 p) = encodePoint x448 p
+groupEncodePublicA (GroupPubA_FFDHE2048 p) = enc ffdhe2048 p
+groupEncodePublicA (GroupPubA_FFDHE3072 p) = enc ffdhe3072 p
+groupEncodePublicA (GroupPubA_FFDHE4096 p) = enc ffdhe4096 p
+groupEncodePublicA (GroupPubA_FFDHE6144 p) = enc ffdhe6144 p
+groupEncodePublicA (GroupPubA_FFDHE8192 p) = enc ffdhe8192 p
+groupEncodePublicA (GroupPubA_MLKEM512 p) = ML.encode p
+groupEncodePublicA (GroupPubA_MLKEM768 p) = ML.encode p
+groupEncodePublicA (GroupPubA_MLKEM1024 p) = ML.encode p
+groupEncodePublicA (GroupPubA_X25519MLKEM768 (p1, p2)) =
+    ML.encode p2 <> encodePoint x25519 p1
+groupEncodePublicA (GroupPubA_P256MLKEM768 (p1, p2)) =
+    encodePoint p256 p1 <> ML.encode p2
+groupEncodePublicA (GroupPubA_P384MLKEM1024 (p1, p2)) =
+    encodePoint p384 p1 <> ML.encode p2
+
+groupEncodePublicB :: GroupPublicB -> ByteString
+groupEncodePublicB (GroupPubB_P256 p) = encodePoint p256 p
+groupEncodePublicB (GroupPubB_P384 p) = encodePoint p384 p
+groupEncodePublicB (GroupPubB_P521 p) = encodePoint p521 p
+groupEncodePublicB (GroupPubB_X255 p) = encodePoint x25519 p
+groupEncodePublicB (GroupPubB_X448 p) = encodePoint x448 p
+groupEncodePublicB (GroupPubB_FFDHE2048 p) = enc ffdhe2048 p
+groupEncodePublicB (GroupPubB_FFDHE3072 p) = enc ffdhe3072 p
+groupEncodePublicB (GroupPubB_FFDHE4096 p) = enc ffdhe4096 p
+groupEncodePublicB (GroupPubB_FFDHE6144 p) = enc ffdhe6144 p
+groupEncodePublicB (GroupPubB_FFDHE8192 p) = enc ffdhe8192 p
+groupEncodePublicB (GroupPubB_MLKEM512 p) = convert p
+groupEncodePublicB (GroupPubB_MLKEM768 p) = convert p
+groupEncodePublicB (GroupPubB_MLKEM1024 p) = convert p
+groupEncodePublicB (GroupPubB_X25519MLKEM768 (p1, p2)) =
+    convert p2 <> encodePoint x25519 p1
+groupEncodePublicB (GroupPubB_P256MLKEM768 (p1, p2)) =
+    encodePoint p256 p1 <> convert p2
+groupEncodePublicB (GroupPubB_P384MLKEM1024 (p1, p2)) =
+    encodePoint p384 p1 <> convert p2
+
+enc :: DH.Params -> PublicNumber -> ByteString
+enc params (PublicNumber p) = i2ospOf_ ((DH.params_bits params + 7) `div` 8) p
+
+groupDecodePublicA :: Group -> ByteString -> Either CryptoError GroupPublicA
+groupDecodePublicA P256 bs = eitherCryptoError $ GroupPubA_P256 <$> decodePoint p256 bs
+groupDecodePublicA P384 bs = eitherCryptoError $ GroupPubA_P384 <$> decodePoint p384 bs
+groupDecodePublicA P521 bs = eitherCryptoError $ GroupPubA_P521 <$> decodePoint p521 bs
+groupDecodePublicA X25519 bs = eitherCryptoError $ GroupPubA_X255 <$> decodePoint x25519 bs
+groupDecodePublicA X448 bs = eitherCryptoError $ GroupPubA_X448 <$> decodePoint x448 bs
+groupDecodePublicA FFDHE2048 bs = Right . GroupPubA_FFDHE2048 . PublicNumber $ os2ip bs
+groupDecodePublicA FFDHE3072 bs = Right . GroupPubA_FFDHE3072 . PublicNumber $ os2ip bs
+groupDecodePublicA FFDHE4096 bs = Right . GroupPubA_FFDHE4096 . PublicNumber $ os2ip bs
+groupDecodePublicA FFDHE6144 bs = Right . GroupPubA_FFDHE6144 . PublicNumber $ os2ip bs
+groupDecodePublicA FFDHE8192 bs = Right . GroupPubA_FFDHE8192 . PublicNumber $ os2ip bs
+groupDecodePublicA MLKEM512 bs = case ML.decode mlkem512 bs of
+    Nothing -> Left CryptoError_PointFormatInvalid
+    Just p -> Right $ GroupPubA_MLKEM512 p
+groupDecodePublicA MLKEM768 bs = case ML.decode mlkem768 bs of
+    Nothing -> Left CryptoError_PointFormatInvalid
+    Just p -> Right $ GroupPubA_MLKEM768 p
+groupDecodePublicA MLKEM1024 bs = case ML.decode mlkem1024 bs of
+    Nothing -> Left CryptoError_PointFormatInvalid
+    Just p -> Right $ GroupPubA_MLKEM1024 p
+groupDecodePublicA X25519MLKEM768 bs =
+    let (bs1, bs2) = BA.splitAt 1184 bs
+     in case ML.decode mlkem768 bs1 of
+            Nothing -> Left CryptoError_PointFormatInvalid
+            Just p1 -> case maybeCryptoError $ decodePoint x25519 bs2 of
+                Nothing -> Left CryptoError_PointFormatInvalid
+                Just p2 -> Right $ GroupPubA_X25519MLKEM768 (p2, p1)
+groupDecodePublicA P256MLKEM768 bs =
+    let (bs1, bs2) = BA.splitAt 65 bs
+     in case ML.decode mlkem768 bs2 of
+            Nothing -> Left CryptoError_PointFormatInvalid
+            Just p1 -> case maybeCryptoError $ decodePoint p256 bs1 of
+                Nothing -> Left CryptoError_PointFormatInvalid
+                Just p2 -> Right $ GroupPubA_P256MLKEM768 (p2, p1)
+groupDecodePublicA P384MLKEM1024 bs =
+    let (bs1, bs2) = BA.splitAt 97 bs
+     in case ML.decode mlkem1024 bs2 of
+            Nothing -> Left CryptoError_PointFormatInvalid
+            Just p1 -> case maybeCryptoError $ decodePoint p384 bs1 of
+                Nothing -> Left CryptoError_PointFormatInvalid
+                Just p2 -> Right $ GroupPubA_P384MLKEM1024 (p2, p1)
+groupDecodePublicA _ _ = error "groupDecodePublicA"
+
+groupDecodePublicB :: Group -> ByteString -> Either CryptoError GroupPublicB
+groupDecodePublicB P256 bs = eitherCryptoError $ GroupPubB_P256 <$> decodePoint p256 bs
+groupDecodePublicB P384 bs = eitherCryptoError $ GroupPubB_P384 <$> decodePoint p384 bs
+groupDecodePublicB P521 bs = eitherCryptoError $ GroupPubB_P521 <$> decodePoint p521 bs
+groupDecodePublicB X25519 bs = eitherCryptoError $ GroupPubB_X255 <$> decodePoint x25519 bs
+groupDecodePublicB X448 bs = eitherCryptoError $ GroupPubB_X448 <$> decodePoint x448 bs
+groupDecodePublicB FFDHE2048 bs = Right . GroupPubB_FFDHE2048 . PublicNumber $ os2ip bs
+groupDecodePublicB FFDHE3072 bs = Right . GroupPubB_FFDHE3072 . PublicNumber $ os2ip bs
+groupDecodePublicB FFDHE4096 bs = Right . GroupPubB_FFDHE4096 . PublicNumber $ os2ip bs
+groupDecodePublicB FFDHE6144 bs = Right . GroupPubB_FFDHE6144 . PublicNumber $ os2ip bs
+groupDecodePublicB FFDHE8192 bs = Right . GroupPubB_FFDHE8192 . PublicNumber $ os2ip bs
+groupDecodePublicB MLKEM512 bs = case ML.decode mlkem512 bs of
+    Nothing -> Left CryptoError_PointFormatInvalid
+    Just p -> Right $ GroupPubB_MLKEM512 p
+groupDecodePublicB MLKEM768 bs = case ML.decode mlkem768 bs of
+    Nothing -> Left CryptoError_PointFormatInvalid
+    Just p -> Right $ GroupPubB_MLKEM768 p
+groupDecodePublicB MLKEM1024 bs = case ML.decode mlkem1024 bs of
+    Nothing -> Left CryptoError_PointFormatInvalid
+    Just p -> Right $ GroupPubB_MLKEM1024 p
+groupDecodePublicB X25519MLKEM768 bs =
+    let (bs1, bs2) = BA.splitAt 1088 bs
+     in case ML.decode mlkem768 bs1 of
+            Nothing -> Left CryptoError_PointFormatInvalid
+            Just p1 -> case maybeCryptoError $ decodePoint x25519 bs2 of
+                Nothing -> Left CryptoError_PointFormatInvalid
+                Just p2 -> Right $ GroupPubB_X25519MLKEM768 (p2, p1)
+groupDecodePublicB P256MLKEM768 bs =
+    let (bs1, bs2) = BA.splitAt 65 bs
+     in case ML.decode mlkem768 bs2 of
+            Nothing -> Left CryptoError_PointFormatInvalid
+            Just p1 -> case maybeCryptoError $ decodePoint p256 bs1 of
+                Nothing -> Left CryptoError_PointFormatInvalid
+                Just p2 -> Right $ GroupPubB_P256MLKEM768 (p2, p1)
+groupDecodePublicB P384MLKEM1024 bs =
+    let (bs1, bs2) = BA.splitAt 97 bs
+     in case ML.decode mlkem1024 bs2 of
+            Nothing -> Left CryptoError_PointFormatInvalid
+            Just p1 -> case maybeCryptoError $ decodePoint p384 bs1 of
+                Nothing -> Left CryptoError_PointFormatInvalid
+                Just p2 -> Right $ GroupPubB_P384MLKEM1024 (p2, p1)
+groupDecodePublicB _ _ = error "groupDecodePublicB"
+
+-- Check that group element in not in the 2-element subgroup { 1, p - 1 }.
+-- See RFC 7919 section 3 and NIST SP 56A rev 2 section 5.6.2.3.1.
+valid :: DH.Params -> PublicNumber -> Bool
+valid (DH.Params p _ _) (PublicNumber y) = 1 < y && y < p - 1
+
+-- strips leading zeros from the result of getShared, as required
+-- for DH(E) pre-main secret in SSL/TLS before version 1.3.
+stripLeadingZeros :: DH.SharedKey -> ScrubbedBytes
+stripLeadingZeros (DH.SharedKey sb) = snd $ BA.span (== 0) sb
+
+-- Use short exponents as optimization, see RFC 7919 section 5.2.
+generatePriv :: MonadRandom r => Int -> r PrivateNumber
+generatePriv e = PrivateNumber <$> generateParams e (Just SetHighest) False
+
+-- Short exponent bit sizes from RFC 7919 appendix A, rounded to next
+-- multiple of 16 bits, i.e. going through a function like:
+-- let shortExp n = head [ e | i <- [1..], let e = n + i, e `mod` 16 == 0 ]
+exp2048 :: Int
+exp3072 :: Int
+exp4096 :: Int
+exp6144 :: Int
+exp8192 :: Int
+exp2048 = 240 -- shortExp 225
+exp3072 = 288 -- shortExp 275
+exp4096 = 336 -- shortExp 325
+exp6144 = 384 -- shortExp 375
+exp8192 = 416 -- shortExp 400
diff --git a/Network/TLS/Crypto/Types.hs b/Network/TLS/Crypto/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Crypto/Types.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-- |
+-- Module      : Network.TLS.Crypto.Types
+-- License     : BSD-style
+-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>
+-- Stability   : experimental
+-- Portability : unknown
+module Network.TLS.Crypto.Types (
+    Group (
+        Group,
+        P256,
+        P384,
+        P521,
+        X25519,
+        X448,
+        FFDHE2048,
+        FFDHE3072,
+        FFDHE4096,
+        FFDHE6144,
+        FFDHE8192,
+        MLKEM512,
+        MLKEM768,
+        MLKEM1024,
+        X25519MLKEM768,
+        P256MLKEM768,
+        P384MLKEM1024
+    ),
+    availableFFGroups,
+    availableECGroups,
+    availableHybridGroups,
+    supportedNamedGroups,
+    supportedNamedGroupsTLS13,
+    KeyExchangeSignatureAlg (..),
+) where
+
+import Codec.Serialise
+import Data.Word
+import GHC.Generics
+
+newtype Group = Group Word16 deriving (Eq, Generic)
+instance Serialise Group
+
+{- FOURMOLU_DISABLE -}
+pattern P256      :: Group
+pattern P256       = Group 23
+pattern P384      :: Group
+pattern P384       = Group 24
+pattern P521      :: Group
+pattern P521       = Group 25
+pattern X25519    :: Group
+pattern X25519     = Group 29
+pattern X448      :: Group
+pattern X448       = Group 30
+pattern FFDHE2048 :: Group
+pattern FFDHE2048  = Group 256
+pattern FFDHE3072 :: Group
+pattern FFDHE3072  = Group 257
+pattern FFDHE4096 :: Group
+pattern FFDHE4096  = Group 258
+pattern FFDHE6144 :: Group
+pattern FFDHE6144  = Group 259
+pattern FFDHE8192 :: Group
+pattern FFDHE8192  = Group 260
+pattern MLKEM512  :: Group
+pattern MLKEM512   = Group 512
+pattern MLKEM768  :: Group
+pattern MLKEM768   = Group 513
+pattern MLKEM1024 :: Group
+pattern MLKEM1024  = Group 514
+pattern X25519MLKEM768 :: Group
+pattern X25519MLKEM768  = Group 4588
+pattern P256MLKEM768   :: Group
+pattern P256MLKEM768    = Group 4587
+pattern P384MLKEM1024  :: Group
+pattern P384MLKEM1024   = Group 4589
+
+instance Show Group where
+    show P256      = "P256"
+    show P384      = "P384"
+    show P521      = "P521"
+    show X25519    = "X25519"
+    show X448      = "X448"
+    show FFDHE2048 = "FFDHE2048"
+    show FFDHE3072 = "FFDHE3072"
+    show FFDHE4096 = "FFDHE4096"
+    show FFDHE6144 = "FFDHE6144"
+    show FFDHE8192 = "FFDHE8192"
+    show MLKEM512  = "MLKEM512"
+    show MLKEM768  = "MLKEM768"
+    show MLKEM1024 = "MLKEM1024"
+    show X25519MLKEM768 = "X25519MLKEM768"
+    show P256MLKEM768   = "P256MLKEM768"
+    show P384MLKEM1024  = "P384MLKEM1024"
+    show (Group x) = "Group " ++ show x
+{- FOURMOLU_ENABLE -}
+
+availableFFGroups :: [Group]
+availableFFGroups = [FFDHE2048, FFDHE3072, FFDHE4096, FFDHE6144, FFDHE8192]
+
+availableECGroups :: [Group]
+availableECGroups = [P256, P384, P521, X25519, X448]
+
+availableHybridGroups :: [Group]
+availableHybridGroups = [X25519MLKEM768, P256MLKEM768, P384MLKEM1024]
+
+-- | A list for named groups.  The ordering is for client preference
+--   because server preference is not used in our server
+--   implementation.
+supportedNamedGroups :: [Group]
+supportedNamedGroups =
+    [ X25519 -- 128 bits security
+    , P256 -- 128 bits security
+    , P384 -- 192 bits security
+    , X448 -- 224 bits security
+    , P521 -- 256 bits security
+    --    , FFDHE2048 -- 103 bits security
+    , FFDHE3072 -- 125 bits security
+    , FFDHE4096 -- 150 bits security
+    , FFDHE6144 -- 175 bits security
+    , FFDHE8192 -- 192 bits security
+    , X25519MLKEM768
+    , P256MLKEM768
+    , P384MLKEM1024
+    , -- , MLKEM512
+      MLKEM768
+    , MLKEM1024
+    ]
+
+supportedNamedGroupsTLS13 :: [[Group]]
+supportedNamedGroupsTLS13 =
+    [ [X25519MLKEM768, P256MLKEM768, P384MLKEM1024]
+    , [X25519, P256]
+    , [P384, X448, P521]
+    , [FFDHE2048, FFDHE3072, FFDHE4096, FFDHE6144, FFDHE8192]
+    , [MLKEM768, MLKEM1024]
+    ]
+
+-- Key-exchange signature algorithm, in close relation to ciphers
+-- (before TLS 1.3).
+data KeyExchangeSignatureAlg = KX_RSA | KX_DSA | KX_ECDSA
+    deriving (Show, Eq)
diff --git a/Network/TLS/ErrT.hs b/Network/TLS/ErrT.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/ErrT.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE CPP #-}
+
+-- | A simple compat ErrorT and other error stuff
+module Network.TLS.ErrT (
+    runErrT,
+    ErrT,
+    MonadError (..),
+) where
+
+import Control.Monad.Except (MonadError (..))
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
+
+runErrT :: ExceptT e m a -> m (Either e a)
+runErrT = runExceptT
+type ErrT = ExceptT
diff --git a/Network/TLS/Error.hs b/Network/TLS/Error.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Error.hs
@@ -0,0 +1,198 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Network.TLS.Error where
+
+import Control.Exception (Exception (..))
+import Data.Typeable
+
+import Network.TLS.Imports
+
+----------------------------------------------------------------
+
+-- | TLSError that might be returned through the TLS stack.
+--
+-- Prior to version 1.8.0, this type had an @Exception@ instance.
+-- In version 1.8.0, this instance was removed, and functions in
+-- this library now only throw 'TLSException'.
+data TLSError
+    = -- | mainly for instance of Error
+      Error_Misc String
+    | -- | A fatal error condition was encountered at a low level.  The
+      -- elements of the tuple give (freeform text description, structured
+      -- error description).
+      Error_Protocol String AlertDescription
+    | -- | A non-fatal error condition was encountered at a low level at a low
+      -- level.  The elements of the tuple give (freeform text description,
+      -- structured error description).
+      Error_Protocol_Warning String AlertDescription
+    | Error_Certificate String
+    | -- | handshake policy failed.
+      Error_HandshakePolicy String
+    | Error_EOF
+    | Error_Packet String
+    | Error_Packet_unexpected String String
+    | Error_Packet_Parsing String
+    | Error_TCP_Terminate
+    deriving (Eq, Show, Typeable)
+
+----------------------------------------------------------------
+
+-- | TLS Exceptions. Some of the data constructors indicate incorrect use of
+--   the library, and the documentation for those data constructors calls
+--   this out. The others wrap 'TLSError' with some kind of context to explain
+--   when the exception occurred.
+data TLSException
+    = -- | Early termination exception with the reason and the error associated
+      Terminated Bool String TLSError
+    | -- | Handshake failed for the reason attached.
+      HandshakeFailed TLSError
+    | -- | Failure occurred while sending or receiving data after the
+      --   TLS handshake succeeded.
+      PostHandshake TLSError
+    | -- | Lifts a 'TLSError' into 'TLSException' without provided any context
+      --   around when the error happened.
+      Uncontextualized TLSError
+    | -- | Usage error when the connection has not been established
+      --   and the user is trying to send or receive data.
+      --   Indicates that this library has been used incorrectly.
+      ConnectionNotEstablished
+    | -- | Expected that a TLS handshake had already taken place, but no TLS
+      --   handshake had occurred.
+      --   Indicates that this library has been used incorrectly.
+      MissingHandshake
+    deriving (Show, Eq, Typeable)
+
+instance Exception TLSException
+
+----------------------------------------------------------------
+
+newtype AlertLevel = AlertLevel {fromAlertLevel :: Word8} deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern AlertLevel_Warning :: AlertLevel
+pattern AlertLevel_Warning  = AlertLevel 1
+pattern AlertLevel_Fatal   :: AlertLevel
+pattern AlertLevel_Fatal    = AlertLevel 2
+
+instance Show AlertLevel where
+    show AlertLevel_Warning = "AlertLevel_Warning"
+    show AlertLevel_Fatal   = "AlertLevel_Fatal"
+    show (AlertLevel x)     = "AlertLevel " ++ show x
+{- FOURMOLU_ENABLE -}
+
+----------------------------------------------------------------
+
+newtype AlertDescription = AlertDescription {fromAlertDescription :: Word8}
+    deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern CloseNotify                  :: AlertDescription
+pattern CloseNotify                   = AlertDescription 0
+pattern UnexpectedMessage            :: AlertDescription
+pattern UnexpectedMessage             = AlertDescription 10
+pattern BadRecordMac                 :: AlertDescription
+pattern BadRecordMac                  = AlertDescription 20
+pattern DecryptionFailed             :: AlertDescription
+pattern DecryptionFailed              = AlertDescription 21
+pattern RecordOverflow               :: AlertDescription
+pattern RecordOverflow                = AlertDescription 22
+pattern DecompressionFailure         :: AlertDescription
+pattern DecompressionFailure          = AlertDescription 30
+pattern HandshakeFailure             :: AlertDescription
+pattern HandshakeFailure              = AlertDescription 40
+pattern BadCertificate               :: AlertDescription
+pattern BadCertificate                = AlertDescription 42
+pattern UnsupportedCertificate       :: AlertDescription
+pattern UnsupportedCertificate        = AlertDescription 43
+pattern CertificateRevoked           :: AlertDescription
+pattern CertificateRevoked            = AlertDescription 44
+pattern CertificateExpired           :: AlertDescription
+pattern CertificateExpired            = AlertDescription 45
+pattern CertificateUnknown           :: AlertDescription
+pattern CertificateUnknown            = AlertDescription 46
+pattern IllegalParameter             :: AlertDescription
+pattern IllegalParameter              = AlertDescription 47
+pattern UnknownCa                    :: AlertDescription
+pattern UnknownCa                     = AlertDescription 48
+pattern AccessDenied                 :: AlertDescription
+pattern AccessDenied                  = AlertDescription 49
+pattern DecodeError                  :: AlertDescription
+pattern DecodeError                   = AlertDescription 50
+pattern DecryptError                 :: AlertDescription
+pattern DecryptError                  = AlertDescription 51
+pattern ExportRestriction            :: AlertDescription
+pattern ExportRestriction             = AlertDescription 60
+pattern ProtocolVersion              :: AlertDescription
+pattern ProtocolVersion               = AlertDescription 70
+pattern InsufficientSecurity         :: AlertDescription
+pattern InsufficientSecurity          = AlertDescription 71
+pattern InternalError                :: AlertDescription
+pattern InternalError                 = AlertDescription 80
+pattern InappropriateFallback        :: AlertDescription
+pattern InappropriateFallback         = AlertDescription 86  -- RFC7507
+pattern UserCanceled                 :: AlertDescription
+pattern UserCanceled                  = AlertDescription 90
+pattern NoRenegotiation              :: AlertDescription
+pattern NoRenegotiation               = AlertDescription 100
+pattern MissingExtension             :: AlertDescription
+pattern MissingExtension              = AlertDescription 109
+pattern UnsupportedExtension         :: AlertDescription
+pattern UnsupportedExtension          = AlertDescription 110
+pattern CertificateUnobtainable      :: AlertDescription
+pattern CertificateUnobtainable       = AlertDescription 111
+pattern UnrecognizedName             :: AlertDescription
+pattern UnrecognizedName              = AlertDescription 112
+pattern BadCertificateStatusResponse :: AlertDescription
+pattern BadCertificateStatusResponse  = AlertDescription 113
+pattern BadCertificateHashValue      :: AlertDescription
+pattern BadCertificateHashValue       = AlertDescription 114
+pattern UnknownPskIdentity           :: AlertDescription
+pattern UnknownPskIdentity            = AlertDescription 115
+pattern CertificateRequired          :: AlertDescription
+pattern CertificateRequired           = AlertDescription 116
+pattern GeneralError                 :: AlertDescription
+pattern GeneralError                  = AlertDescription 117
+pattern NoApplicationProtocol        :: AlertDescription
+pattern NoApplicationProtocol         = AlertDescription 120 -- RFC7301
+pattern EchRequired                  :: AlertDescription
+pattern EchRequired                   = AlertDescription 121 -- draft
+
+instance Show AlertDescription where
+    show CloseNotify                  = "CloseNotify"
+    show UnexpectedMessage            = "UnexpectedMessage"
+    show BadRecordMac                 = "BadRecordMac"
+    show DecryptionFailed             = "DecryptionFailed"
+    show RecordOverflow               = "RecordOverflow"
+    show DecompressionFailure         = "DecompressionFailure"
+    show HandshakeFailure             = "HandshakeFailure"
+    show BadCertificate               = "BadCertificate"
+    show UnsupportedCertificate       = "UnsupportedCertificate"
+    show CertificateRevoked           = "CertificateRevoked"
+    show CertificateExpired           = "CertificateExpired"
+    show CertificateUnknown           = "CertificateUnknown"
+    show IllegalParameter             = "IllegalParameter"
+    show UnknownCa                    = "UnknownCa"
+    show AccessDenied                 = "AccessDenied"
+    show DecodeError                  = "DecodeError"
+    show DecryptError                 = "DecryptError"
+    show ExportRestriction            = "ExportRestriction"
+    show ProtocolVersion              = "ProtocolVersion"
+    show InsufficientSecurity         = "InsufficientSecurity"
+    show InternalError                = "InternalError"
+    show InappropriateFallback        = "InappropriateFallback"
+    show UserCanceled                 = "UserCanceled"
+    show NoRenegotiation              = "NoRenegotiation"
+    show MissingExtension             = "MissingExtension"
+    show UnsupportedExtension         = "UnsupportedExtension"
+    show CertificateUnobtainable      = "CertificateUnobtainable"
+    show UnrecognizedName             = "UnrecognizedName"
+    show BadCertificateStatusResponse = "BadCertificateStatusResponse"
+    show BadCertificateHashValue      = "BadCertificateHashValue"
+    show UnknownPskIdentity           = "UnknownPskIdentity"
+    show CertificateRequired          = "CertificateRequired"
+    show GeneralError                 = "GeneralError"
+    show NoApplicationProtocol        = "NoApplicationProtocol"
+    show EchRequired                  = "EchRequired"
+    show (AlertDescription x)         = "AlertDescription " ++ show x
+{- FOURMOLU_ENABLE -}
diff --git a/Network/TLS/Extension.hs b/Network/TLS/Extension.hs
--- a/Network/TLS/Extension.hs
+++ b/Network/TLS/Extension.hs
@@ -1,133 +1,1175 @@
--- |
--- Module      : Network.TLS.Extension
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- basic extensions are defined in RFC 6066
---
-module Network.TLS.Extension
-    ( Extension(..)
-    , supportedExtensions
-    -- all extensions ID supported
-    , extensionID_ServerName
-    , extensionID_MaxFragmentLength
-    , extensionID_SecureRenegotiation
-    , extensionID_NextProtocolNegotiation
-    -- all implemented extensions
-    , ServerNameType(..)
-    , ServerName(..)
-    , MaxFragmentLength(..)
-    , MaxFragmentEnum(..)
-    , SecureRenegotiation(..)
-    , NextProtocolNegotiation(..)
-    ) where
-
-import Control.Applicative ((<$>))
-import Control.Monad
-
-import Data.Word
-import Data.Maybe (fromMaybe)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
-
-import Network.TLS.Struct (ExtensionID)
-import Network.TLS.Wire
-import Network.BSD (HostName)
-
-extensionID_ServerName, extensionID_MaxFragmentLength
-                      , extensionID_SecureRenegotiation
-                      , extensionID_NextProtocolNegotiation :: ExtensionID
-extensionID_ServerName              = 0x0
-extensionID_MaxFragmentLength       = 0x1
-extensionID_SecureRenegotiation     = 0xff01
-extensionID_NextProtocolNegotiation = 0x3374
-
--- | all supported extensions by the implementation
-supportedExtensions :: [ExtensionID]
-supportedExtensions = [ extensionID_ServerName
-                      , extensionID_MaxFragmentLength
-                      , extensionID_SecureRenegotiation
-                      , extensionID_NextProtocolNegotiation
-                      ]
-
--- | Extension class to transform bytes to and from a high level Extension type.
-class Extension a where
-    extensionID     :: a -> ExtensionID
-    extensionDecode :: Bool -> ByteString -> Maybe a
-    extensionEncode :: a -> ByteString
-
--- | Server Name extension including the name type and the associated name.
--- the associated name decoding is dependant of its name type.
--- name type = 0 : hostname
-data ServerName = ServerName [ServerNameType]
-    deriving (Show,Eq)
-
-data ServerNameType = ServerNameHostName HostName
-                    | ServerNameOther    (Word8, ByteString)
-                    deriving (Show,Eq)
-
-instance Extension ServerName where
-    extensionID _ = extensionID_ServerName
-    extensionEncode (ServerName l) = runPut $ putOpaque16 (runPut $ mapM_ encodeNameType l)
-        where encodeNameType (ServerNameHostName hn)       = putWord8 0  >> putOpaque16 (BC.pack hn) -- FIXME: should be puny code conversion
-              encodeNameType (ServerNameOther (nt,opaque)) = putWord8 nt >> putBytes opaque
-    extensionDecode _ = runGetMaybe (getWord16 >>= \len -> getList (fromIntegral len) getServerName >>= return . ServerName)
-        where getServerName = do
-                  ty    <- getWord8
-                  sname <- getOpaque16
-                  return (1+2+B.length sname, case ty of
-                      0 -> ServerNameHostName $ BC.unpack sname -- FIXME: should be puny code conversion
-                      _ -> ServerNameOther (ty, sname))
-
--- | Max fragment extension with length from 512 bytes to 4096 bytes
-data MaxFragmentLength = MaxFragmentLength MaxFragmentEnum
-    deriving (Show,Eq)
-data MaxFragmentEnum = MaxFragment512 | MaxFragment1024 | MaxFragment2048 | MaxFragment4096
-    deriving (Show,Eq)
-
-instance Extension MaxFragmentLength where
-    extensionID _ = extensionID_MaxFragmentLength
-    extensionEncode (MaxFragmentLength e) = B.singleton $ marshallSize e
-        where marshallSize MaxFragment512  = 1
-              marshallSize MaxFragment1024 = 2
-              marshallSize MaxFragment2048 = 3
-              marshallSize MaxFragment4096 = 4
-    extensionDecode _ = runGetMaybe (MaxFragmentLength . unmarshallSize <$> getWord8)
-        where unmarshallSize 1 = MaxFragment512
-              unmarshallSize 2 = MaxFragment1024
-              unmarshallSize 3 = MaxFragment2048
-              unmarshallSize 4 = MaxFragment4096
-              unmarshallSize n = error ("unknown max fragment size " ++ show n)
-
--- | Secure Renegotiation
-data SecureRenegotiation = SecureRenegotiation ByteString (Maybe ByteString)
-    deriving (Show,Eq)
-
-instance Extension SecureRenegotiation where
-    extensionID _ = extensionID_SecureRenegotiation
-    extensionEncode (SecureRenegotiation cvd svd) =
-        runPut $ putOpaque8 (cvd `B.append` fromMaybe B.empty svd)
-    extensionDecode isServerHello = runGetMaybe $ do
-        opaque <- getOpaque8
-        if isServerHello
-           then let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque
-                 in return $ SecureRenegotiation cvd (Just svd)
-           else return $ SecureRenegotiation opaque Nothing
-
--- | Next Protocol Negotiation
-data NextProtocolNegotiation = NextProtocolNegotiation [ByteString]
-    deriving (Show,Eq)
-
-instance Extension NextProtocolNegotiation where
-    extensionID _ = extensionID_NextProtocolNegotiation
-    extensionEncode (NextProtocolNegotiation bytes) =
-        runPut $ mapM_ putOpaque8 bytes
-    extensionDecode _ = runGetMaybe (NextProtocolNegotiation <$> getNPN)
-        where getNPN = do
-                 avail <- remaining
-                 case avail of
-                     0 -> return []
-                     _ -> do liftM2 (:) getOpaque8 getNPN
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Basic extensions are defined in RFC 6066
+module Network.TLS.Extension (
+    -- * Extension identifiers
+    ExtensionID (
+        ..,
+        EID_ServerName,
+        EID_MaxFragmentLength,
+        EID_ClientCertificateUrl,
+        EID_TrustedCAKeys,
+        EID_TruncatedHMAC,
+        EID_StatusRequest,
+        EID_UserMapping,
+        EID_ClientAuthz,
+        EID_ServerAuthz,
+        EID_CertType,
+        EID_SupportedGroups,
+        EID_EcPointFormats,
+        EID_SRP,
+        EID_SignatureAlgorithms,
+        EID_SRTP,
+        EID_Heartbeat,
+        EID_ApplicationLayerProtocolNegotiation,
+        EID_StatusRequestv2,
+        EID_SignedCertificateTimestamp,
+        EID_ClientCertificateType,
+        EID_ServerCertificateType,
+        EID_Padding,
+        EID_EncryptThenMAC,
+        EID_ExtendedMainSecret,
+        EID_CompressCertificate,
+        EID_RecordSizeLimit,
+        EID_SessionTicket,
+        EID_PreSharedKey,
+        EID_EarlyData,
+        EID_SupportedVersions,
+        EID_Cookie,
+        EID_PskKeyExchangeModes,
+        EID_CertificateAuthorities,
+        EID_OidFilters,
+        EID_PostHandshakeAuth,
+        EID_SignatureAlgorithmsCert,
+        EID_KeyShare,
+        EID_QuicTransportParameters,
+        EID_EchOuterExtensions,
+        EID_EncryptedClientHello,
+        EID_SecureRenegotiation
+    ),
+    definedExtensions,
+    supportedExtensions,
+
+    -- * Extension raw
+    ExtensionRaw (..),
+    toExtensionRaw,
+    extensionLookup,
+    lookupAndDecode,
+    lookupAndDecodeAndDo,
+
+    -- * Class
+    Extension (..),
+
+    -- * Extensions
+    ServerNameType (..),
+    ServerName (..),
+    MaxFragmentLength (..),
+    MaxFragmentEnum (..),
+    SecureRenegotiation (..),
+    ApplicationLayerProtocolNegotiation (..),
+    ExtendedMainSecret (..),
+    CertificateCompressionAlgorithm (.., CCA_Zlib, CCA_Brotli, CCA_Zstd),
+    CompressCertificate (..),
+    SupportedGroups (..),
+    Group (..),
+    EcPointFormatsSupported (..),
+    EcPointFormat (
+        EcPointFormat,
+        EcPointFormat_Uncompressed,
+        EcPointFormat_AnsiX962_compressed_prime,
+        EcPointFormat_AnsiX962_compressed_char2
+    ),
+    RecordSizeLimit (..),
+    SessionTicket (..),
+    HeartBeat (..),
+    HeartBeatMode (
+        HeartBeatMode,
+        HeartBeat_PeerAllowedToSend,
+        HeartBeat_PeerNotAllowedToSend
+    ),
+    SignatureAlgorithms (..),
+    SignatureAlgorithmsCert (..),
+    SupportedVersions (..),
+    KeyShare (..),
+    KeyShareEntry (..),
+    MessageType (..),
+    PostHandshakeAuth (..),
+    PskKexMode (PskKexMode, PSK_KE, PSK_DHE_KE),
+    PskKeyExchangeModes (..),
+    PskIdentity (..),
+    PreSharedKey (..),
+    EarlyDataIndication (..),
+    Cookie (..),
+    CertificateAuthorities (..),
+    EchOuterExtensions (..),
+    EncryptedClientHello (..),
+) where
+
+import qualified Control.Exception as E
+import Crypto.HPKE
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import Data.X509 (DistinguishedName)
+
+import Network.TLS.ECH.Config
+
+import Network.TLS.Crypto.Types
+import Network.TLS.Error
+import Network.TLS.HashAndSignature
+import Network.TLS.Imports
+import Network.TLS.Packet (
+    getBinaryVersion,
+    getDNames,
+    getSignatureHashAlgorithm,
+    putBinaryVersion,
+    putDNames,
+    putSignatureHashAlgorithm,
+ )
+import Network.TLS.Types (HostName, Ticket, Version)
+import Network.TLS.Wire
+
+----------------------------------------------------------------
+-- Extension identifiers
+
+-- | Identifier of a TLS extension.
+--   <http://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.txt>
+newtype ExtensionID = ExtensionID {fromExtensionID :: Word16} deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern EID_ServerName                          :: ExtensionID -- RFC6066
+pattern EID_ServerName                           = ExtensionID 0x0
+pattern EID_MaxFragmentLength                   :: ExtensionID -- RFC6066
+pattern EID_MaxFragmentLength                    = ExtensionID 0x1
+pattern EID_ClientCertificateUrl                :: ExtensionID -- RFC6066
+pattern EID_ClientCertificateUrl                 = ExtensionID 0x2
+pattern EID_TrustedCAKeys                       :: ExtensionID -- RFC6066
+pattern EID_TrustedCAKeys                        = ExtensionID 0x3
+pattern EID_TruncatedHMAC                       :: ExtensionID -- RFC6066
+pattern EID_TruncatedHMAC                        = ExtensionID 0x4
+pattern EID_StatusRequest                       :: ExtensionID -- RFC6066
+pattern EID_StatusRequest                        = ExtensionID 0x5
+pattern EID_UserMapping                         :: ExtensionID -- RFC4681
+pattern EID_UserMapping                          = ExtensionID 0x6
+pattern EID_ClientAuthz                         :: ExtensionID -- RFC5878
+pattern EID_ClientAuthz                          = ExtensionID 0x7
+pattern EID_ServerAuthz                         :: ExtensionID -- RFC5878
+pattern EID_ServerAuthz                          = ExtensionID 0x8
+pattern EID_CertType                            :: ExtensionID -- RFC6091
+pattern EID_CertType                             = ExtensionID 0x9
+pattern EID_SupportedGroups                     :: ExtensionID -- RFC8422,8446
+pattern EID_SupportedGroups                      = ExtensionID 0xa
+pattern EID_EcPointFormats                      :: ExtensionID -- RFC4492
+pattern EID_EcPointFormats                       = ExtensionID 0xb
+pattern EID_SRP                                 :: ExtensionID -- RFC5054
+pattern EID_SRP                                  = ExtensionID 0xc
+pattern EID_SignatureAlgorithms                 :: ExtensionID -- RFC5246,8446
+pattern EID_SignatureAlgorithms                  = ExtensionID 0xd
+pattern EID_SRTP                                :: ExtensionID -- RFC5764
+pattern EID_SRTP                                 = ExtensionID 0xe
+pattern EID_Heartbeat                           :: ExtensionID -- RFC6520
+pattern EID_Heartbeat                            = ExtensionID 0xf
+pattern EID_ApplicationLayerProtocolNegotiation :: ExtensionID -- RFC7301
+pattern EID_ApplicationLayerProtocolNegotiation  = ExtensionID 0x10
+pattern EID_StatusRequestv2                     :: ExtensionID -- RFC6961
+pattern EID_StatusRequestv2                      = ExtensionID 0x11
+pattern EID_SignedCertificateTimestamp          :: ExtensionID -- RFC6962
+pattern EID_SignedCertificateTimestamp           = ExtensionID 0x12
+pattern EID_ClientCertificateType               :: ExtensionID -- RFC7250
+pattern EID_ClientCertificateType                = ExtensionID 0x13
+pattern EID_ServerCertificateType               :: ExtensionID -- RFC7250
+pattern EID_ServerCertificateType                = ExtensionID 0x14
+pattern EID_Padding                             :: ExtensionID -- RFC5246
+pattern EID_Padding                              = ExtensionID 0x15
+pattern EID_EncryptThenMAC                      :: ExtensionID -- RFC7366
+pattern EID_EncryptThenMAC                       = ExtensionID 0x16
+pattern EID_ExtendedMainSecret                  :: ExtensionID -- REF7627
+pattern EID_ExtendedMainSecret                   = ExtensionID 0x17
+pattern EID_CompressCertificate                 :: ExtensionID -- RFC8879
+pattern EID_CompressCertificate                  = ExtensionID 0x1b
+pattern EID_RecordSizeLimit                     :: ExtensionID -- RFC8449
+pattern EID_RecordSizeLimit                      = ExtensionID 0x1c
+pattern EID_SessionTicket                       :: ExtensionID -- RFC4507
+pattern EID_SessionTicket                        = ExtensionID 0x23
+pattern EID_PreSharedKey                        :: ExtensionID -- RFC8446
+pattern EID_PreSharedKey                         = ExtensionID 0x29
+pattern EID_EarlyData                           :: ExtensionID -- RFC8446
+pattern EID_EarlyData                            = ExtensionID 0x2a
+pattern EID_SupportedVersions                   :: ExtensionID -- RFC8446
+pattern EID_SupportedVersions                    = ExtensionID 0x2b
+pattern EID_Cookie                              :: ExtensionID -- RFC8446
+pattern EID_Cookie                               = ExtensionID 0x2c
+pattern EID_PskKeyExchangeModes                 :: ExtensionID -- RFC8446
+pattern EID_PskKeyExchangeModes                  = ExtensionID 0x2d
+pattern EID_CertificateAuthorities              :: ExtensionID -- RFC8446
+pattern EID_CertificateAuthorities               = ExtensionID 0x2f
+pattern EID_OidFilters                          :: ExtensionID -- RFC8446
+pattern EID_OidFilters                           = ExtensionID 0x30
+pattern EID_PostHandshakeAuth                   :: ExtensionID -- RFC8446
+pattern EID_PostHandshakeAuth                    = ExtensionID 0x31
+pattern EID_SignatureAlgorithmsCert             :: ExtensionID -- RFC8446
+pattern EID_SignatureAlgorithmsCert              = ExtensionID 0x32
+pattern EID_KeyShare                            :: ExtensionID -- RFC8446
+pattern EID_KeyShare                             = ExtensionID 0x33
+pattern EID_QuicTransportParameters             :: ExtensionID -- RFC9001
+pattern EID_QuicTransportParameters              = ExtensionID 0x39
+pattern EID_EchOuterExtensions                  :: ExtensionID -- draft
+pattern EID_EchOuterExtensions                   = ExtensionID 0xfd00
+pattern EID_EncryptedClientHello                :: ExtensionID -- draft
+pattern EID_EncryptedClientHello                 = ExtensionID 0xfe0d
+pattern EID_SecureRenegotiation                 :: ExtensionID -- RFC5746
+pattern EID_SecureRenegotiation                  = ExtensionID 0xff01
+
+instance Show ExtensionID where
+    show EID_ServerName              = "ServerName"
+    show EID_MaxFragmentLength       = "MaxFragmentLength"
+    show EID_ClientCertificateUrl    = "ClientCertificateUrl"
+    show EID_TrustedCAKeys           = "TrustedCAKeys"
+    show EID_TruncatedHMAC           = "TruncatedHMAC"
+    show EID_StatusRequest           = "StatusRequest"
+    show EID_UserMapping             = "UserMapping"
+    show EID_ClientAuthz             = "ClientAuthz"
+    show EID_ServerAuthz             = "ServerAuthz"
+    show EID_CertType                = "CertType"
+    show EID_SupportedGroups         = "SupportedGroups"
+    show EID_EcPointFormats          = "EcPointFormats"
+    show EID_SRP                     = "SRP"
+    show EID_SignatureAlgorithms     = "SignatureAlgorithms"
+    show EID_SRTP                    = "SRTP"
+    show EID_Heartbeat               = "Heartbeat"
+    show EID_ApplicationLayerProtocolNegotiation = "ApplicationLayerProtocolNegotiation"
+    show EID_StatusRequestv2         = "StatusRequestv2"
+    show EID_SignedCertificateTimestamp = "SignedCertificateTimestamp"
+    show EID_ClientCertificateType   = "ClientCertificateType"
+    show EID_ServerCertificateType   = "ServerCertificateType"
+    show EID_Padding                 = "Padding"
+    show EID_EncryptThenMAC          = "EncryptThenMAC"
+    show EID_ExtendedMainSecret      = "ExtendedMainSecret"
+    show EID_CompressCertificate     = "CompressCertificate"
+    show EID_RecordSizeLimit         = "RecordSizeLimit"
+    show EID_SessionTicket           = "SessionTicket"
+    show EID_PreSharedKey            = "PreSharedKey"
+    show EID_EarlyData               = "EarlyData"
+    show EID_SupportedVersions       = "SupportedVersions"
+    show EID_Cookie                  = "Cookie"
+    show EID_PskKeyExchangeModes     = "PskKeyExchangeModes"
+    show EID_CertificateAuthorities  = "CertificateAuthorities"
+    show EID_OidFilters              = "OidFilters"
+    show EID_PostHandshakeAuth       = "PostHandshakeAuth"
+    show EID_SignatureAlgorithmsCert = "SignatureAlgorithmsCert"
+    show EID_KeyShare                = "KeyShare"
+    show EID_QuicTransportParameters = "QuicTransportParameters"
+    show EID_EchOuterExtensions      = "EchOuterExtensions"
+    show EID_EncryptedClientHello    = "EncryptedClientHello"
+    show EID_SecureRenegotiation     = "SecureRenegotiation"
+    show (ExtensionID x)             = "ExtensionID " ++ show x
+{- FOURMOLU_ENABLE -}
+
+------------------------------------------------------------
+
+definedExtensions :: [ExtensionID]
+definedExtensions =
+    [ EID_ServerName
+    , EID_MaxFragmentLength
+    , EID_ClientCertificateUrl
+    , EID_TrustedCAKeys
+    , EID_TruncatedHMAC
+    , EID_StatusRequest
+    , EID_UserMapping
+    , EID_ClientAuthz
+    , EID_ServerAuthz
+    , EID_CertType
+    , EID_SupportedGroups
+    , EID_EcPointFormats
+    , EID_SRP
+    , EID_SignatureAlgorithms
+    , EID_SRTP
+    , EID_Heartbeat
+    , EID_ApplicationLayerProtocolNegotiation
+    , EID_StatusRequestv2
+    , EID_SignedCertificateTimestamp
+    , EID_ClientCertificateType
+    , EID_ServerCertificateType
+    , EID_Padding
+    , EID_EncryptThenMAC
+    , EID_ExtendedMainSecret
+    , EID_CompressCertificate
+    , EID_RecordSizeLimit
+    , EID_SessionTicket
+    , EID_PreSharedKey
+    , EID_EarlyData
+    , EID_SupportedVersions
+    , EID_Cookie
+    , EID_PskKeyExchangeModes
+    , EID_CertificateAuthorities
+    , EID_OidFilters
+    , EID_PostHandshakeAuth
+    , EID_SignatureAlgorithmsCert
+    , EID_KeyShare
+    , EID_QuicTransportParameters
+    , EID_EchOuterExtensions
+    , EID_EncryptedClientHello
+    , EID_SecureRenegotiation
+    ]
+
+-- | all supported extensions by the implementation
+{- FOURMOLU_DISABLE -}
+supportedExtensions :: [ExtensionID]
+supportedExtensions =
+    [ EID_ServerName                          -- 0x00
+    , EID_SupportedGroups                     -- 0x0a
+    , EID_EcPointFormats                      -- 0x0b
+    , EID_SignatureAlgorithms                 -- 0x0d
+    , EID_ApplicationLayerProtocolNegotiation -- 0x10
+    , EID_ExtendedMainSecret                  -- 0x17
+    , EID_CompressCertificate                 -- 0x1b
+    , EID_RecordSizeLimit                     -- 0x1c
+    , EID_SessionTicket                       -- 0x23
+    , EID_PreSharedKey                        -- 0x29
+    , EID_EarlyData                           -- 0x2a
+    , EID_SupportedVersions                   -- 0x2b
+    , EID_Cookie                              -- 0x2c
+    , EID_PskKeyExchangeModes                 -- 0x2d
+    , EID_CertificateAuthorities              -- 0x2f
+    , EID_PostHandshakeAuth                   -- 0x31
+    , EID_SignatureAlgorithmsCert             -- 0x32
+    , EID_KeyShare                            -- 0x33
+    , EID_QuicTransportParameters             -- 0x39
+    , EID_EchOuterExtensions                  -- 0xfd00
+    , EID_EncryptedClientHello                -- 0xfe0d
+    , EID_SecureRenegotiation                 -- 0xff01
+    ]
+{- FOURMOLU_ENABLE -}
+
+----------------------------------------------------------------
+
+-- | The raw content of a TLS extension.
+data ExtensionRaw = ExtensionRaw ExtensionID ByteString
+    deriving (Eq)
+
+instance Show ExtensionRaw where
+    show (ExtensionRaw eid@EID_ServerName bs) = showExtensionRaw eid bs decodeServerName
+    show (ExtensionRaw eid@EID_MaxFragmentLength bs) = showExtensionRaw eid bs decodeMaxFragmentLength
+    show (ExtensionRaw eid@EID_SupportedGroups bs) = showExtensionRaw eid bs decodeSupportedGroups
+    show (ExtensionRaw eid@EID_EcPointFormats bs) = showExtensionRaw eid bs decodeEcPointFormatsSupported
+    show (ExtensionRaw eid@EID_SignatureAlgorithms bs) = showExtensionRaw eid bs decodeSignatureAlgorithms
+    show (ExtensionRaw eid@EID_Heartbeat bs) = showExtensionRaw eid bs decodeHeartBeat
+    show (ExtensionRaw eid@EID_ApplicationLayerProtocolNegotiation bs) = showExtensionRaw eid bs decodeApplicationLayerProtocolNegotiation
+    show (ExtensionRaw eid@EID_ExtendedMainSecret _) = show eid
+    show (ExtensionRaw eid@EID_CompressCertificate bs) = showExtensionRaw eid bs decodeCompressCertificate
+    show (ExtensionRaw eid@EID_RecordSizeLimit bs) = showExtensionRaw eid bs decodeRecordSizeLimit
+    show (ExtensionRaw eid@EID_SessionTicket bs) = showExtensionRaw eid bs decodeSessionTicket
+    show (ExtensionRaw eid@EID_PreSharedKey bs) = showExtensionRaw eid bs decodePreSharedKey
+    show (ExtensionRaw eid@EID_EarlyData _) = show eid
+    show (ExtensionRaw eid@EID_SupportedVersions bs) = showExtensionRaw eid bs decodeSupportedVersions
+    show (ExtensionRaw eid@EID_Cookie bs) = show eid ++ " " ++ showBytesHex bs
+    show (ExtensionRaw eid@EID_PskKeyExchangeModes bs) = showExtensionRaw eid bs decodePskKeyExchangeModes
+    show (ExtensionRaw eid@EID_CertificateAuthorities bs) = showExtensionRaw eid bs decodeCertificateAuthorities
+    show (ExtensionRaw eid@EID_PostHandshakeAuth _) = show eid
+    show (ExtensionRaw eid@EID_SignatureAlgorithmsCert bs) = showExtensionRaw eid bs decodeSignatureAlgorithmsCert
+    show (ExtensionRaw eid@EID_KeyShare bs) = showExtensionRaw eid bs decodeKeyShare
+    show (ExtensionRaw eid@EID_EchOuterExtensions bs) = showExtensionRaw eid bs decodeEchOuterExtensions
+    show (ExtensionRaw eid@EID_EncryptedClientHello bs) = showExtensionRaw eid bs decodeECH
+    show (ExtensionRaw eid@EID_SecureRenegotiation bs) = show eid ++ " " ++ showBytesHex bs
+    show (ExtensionRaw eid bs) = "ExtensionRaw " ++ show eid ++ " " ++ showBytesHex bs
+
+showExtensionRaw
+    :: Show a => ExtensionID -> ByteString -> (ByteString -> Maybe a) -> String
+showExtensionRaw eid bs decode = case decode bs of
+    Nothing -> show eid ++ " broken"
+    Just x -> show x
+
+toExtensionRaw :: Extension e => e -> ExtensionRaw
+toExtensionRaw ext = ExtensionRaw (extensionID ext) (extensionEncode ext)
+
+extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe ByteString
+extensionLookup toFind exts = extract <$> find idEq exts
+  where
+    extract (ExtensionRaw _ content) = content
+    idEq (ExtensionRaw eid _) = eid == toFind
+
+lookupAndDecode
+    :: Extension e
+    => ExtensionID
+    -> MessageType
+    -> [ExtensionRaw]
+    -> a
+    -> (e -> a)
+    -> a
+lookupAndDecode eid msgtyp exts defval conv = case extensionLookup eid exts of
+    Nothing -> defval
+    Just bs -> case extensionDecode msgtyp bs of
+        Nothing ->
+            E.throw $
+                Uncontextualized $
+                    Error_Protocol ("Illegal " ++ show eid) DecodeError
+        Just val -> conv val
+
+lookupAndDecodeAndDo
+    :: Extension a
+    => ExtensionID
+    -> MessageType
+    -> [ExtensionRaw]
+    -> IO b
+    -> (a -> IO b)
+    -> IO b
+lookupAndDecodeAndDo eid msgtyp exts defAction action = case extensionLookup eid exts of
+    Nothing -> defAction
+    Just bs -> case extensionDecode msgtyp bs of
+        Nothing ->
+            E.throwIO $
+                Uncontextualized $
+                    Error_Protocol ("Illegal " ++ show eid) DecodeError
+        Just val -> action val
+
+------------------------------------------------------------
+
+-- | Extension class to transform bytes to and from a high level Extension type.
+class Extension a where
+    extensionID :: a -> ExtensionID
+    extensionDecode :: MessageType -> ByteString -> Maybe a
+    extensionEncode :: a -> ByteString
+
+data MessageType
+    = MsgTClientHello
+    | MsgTServerHello
+    | MsgTHelloRetryRequest
+    | MsgTEncryptedExtensions
+    | MsgTNewSessionTicket
+    | MsgTCertificateRequest
+    deriving (Eq, Show)
+
+------------------------------------------------------------
+
+-- | Server Name extension including the name type and the associated name.
+-- the associated name decoding is dependent of its name type.
+-- name type = 0 : hostname
+newtype ServerName = ServerName [ServerNameType] deriving (Show, Eq)
+
+data ServerNameType
+    = ServerNameHostName HostName
+    | ServerNameOther (Word8, ByteString)
+    deriving (Eq)
+
+instance Show ServerNameType where
+    show (ServerNameHostName host) = "\"" ++ host ++ "\""
+    show (ServerNameOther (w, _)) = "(" ++ show w ++ ", )"
+
+instance Extension ServerName where
+    extensionID _ = EID_ServerName
+
+    -- dirty hack for servers
+    extensionEncode (ServerName []) = ""
+    -- for clients
+    extensionEncode (ServerName l) = runPut $ putOpaque16 (runPut $ mapM_ encodeNameType l)
+      where
+        encodeNameType (ServerNameHostName hn) = putWord8 0 >> putOpaque16 (BC.pack hn) -- FIXME: should be puny code conversion
+        encodeNameType (ServerNameOther (nt, opaque)) = putWord8 nt >> putBytes opaque
+    extensionDecode MsgTClientHello = decodeServerName
+    extensionDecode MsgTServerHello = decodeServerName
+    extensionDecode MsgTEncryptedExtensions = decodeServerName
+    extensionDecode _ = error "extensionDecode: ServerName"
+
+decodeServerName :: ByteString -> Maybe ServerName
+decodeServerName "" = Just $ ServerName [] -- dirty hack for servers
+decodeServerName bs = runGetMaybe decode bs
+  where
+    decode = do
+        len <- fromIntegral <$> getWord16
+        ServerName <$> getList len getServerName
+    getServerName = do
+        ty <- getWord8
+        snameParsed <- getOpaque16
+        let sname = B.copy snameParsed
+            name = case ty of
+                0 -> ServerNameHostName $ BC.unpack sname -- FIXME: should be puny code conversion
+                _ -> ServerNameOther (ty, sname)
+        return (1 + 2 + B.length sname, name)
+
+------------------------------------------------------------
+
+-- | Max fragment extension with length from 512 bytes to 4096 bytes
+--
+-- RFC 6066 defines:
+-- If a server receives a maximum fragment length negotiation request
+-- for a value other than the allowed values, it MUST abort the
+-- handshake with an "illegal_parameter" alert.
+--
+-- So, if a server receives MaxFragmentLengthOther, it must send the alert.
+data MaxFragmentLength
+    = MaxFragmentLength MaxFragmentEnum
+    | MaxFragmentLengthOther Word8
+    deriving (Show, Eq)
+
+data MaxFragmentEnum
+    = MaxFragment512
+    | MaxFragment1024
+    | MaxFragment2048
+    | MaxFragment4096
+    deriving (Show, Eq)
+
+instance Extension MaxFragmentLength where
+    extensionID _ = EID_MaxFragmentLength
+    extensionEncode (MaxFragmentLength l) = runPut $ putWord8 $ fromMaxFragmentEnum l
+      where
+        fromMaxFragmentEnum MaxFragment512 = 1
+        fromMaxFragmentEnum MaxFragment1024 = 2
+        fromMaxFragmentEnum MaxFragment2048 = 3
+        fromMaxFragmentEnum MaxFragment4096 = 4
+    extensionEncode (MaxFragmentLengthOther l) = runPut $ putWord8 l
+    extensionDecode MsgTClientHello = decodeMaxFragmentLength
+    extensionDecode MsgTServerHello = decodeMaxFragmentLength
+    extensionDecode MsgTEncryptedExtensions = decodeMaxFragmentLength
+    extensionDecode _ = error "extensionDecode: MaxFragmentLength"
+
+decodeMaxFragmentLength :: ByteString -> Maybe MaxFragmentLength
+decodeMaxFragmentLength = runGetMaybe $ toMaxFragmentEnum <$> getWord8
+  where
+    toMaxFragmentEnum 1 = MaxFragmentLength MaxFragment512
+    toMaxFragmentEnum 2 = MaxFragmentLength MaxFragment1024
+    toMaxFragmentEnum 3 = MaxFragmentLength MaxFragment2048
+    toMaxFragmentEnum 4 = MaxFragmentLength MaxFragment4096
+    toMaxFragmentEnum n = MaxFragmentLengthOther n
+
+------------------------------------------------------------
+
+newtype SupportedGroups = SupportedGroups [Group] deriving (Show, Eq)
+
+-- on decode, filter all unknown curves
+instance Extension SupportedGroups where
+    extensionID _ = EID_SupportedGroups
+    extensionEncode (SupportedGroups groups) = runPut $ putWords16 $ map (\(Group g) -> g) groups
+    extensionDecode MsgTClientHello = decodeSupportedGroups
+    extensionDecode MsgTEncryptedExtensions = decodeSupportedGroups
+    extensionDecode _ = error "extensionDecode: SupportedGroups"
+
+decodeSupportedGroups :: ByteString -> Maybe SupportedGroups
+decodeSupportedGroups =
+    runGetMaybe (SupportedGroups . map Group <$> getWords16)
+
+------------------------------------------------------------
+
+newtype EcPointFormatsSupported = EcPointFormatsSupported [EcPointFormat]
+    deriving (Show, Eq)
+
+newtype EcPointFormat = EcPointFormat {fromEcPointFormat :: Word8}
+    deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern EcPointFormat_Uncompressed              :: EcPointFormat
+pattern EcPointFormat_Uncompressed               = EcPointFormat 0
+pattern EcPointFormat_AnsiX962_compressed_prime :: EcPointFormat
+pattern EcPointFormat_AnsiX962_compressed_prime  = EcPointFormat 1
+pattern EcPointFormat_AnsiX962_compressed_char2 :: EcPointFormat
+pattern EcPointFormat_AnsiX962_compressed_char2  = EcPointFormat 2
+
+instance Show EcPointFormat where
+    show EcPointFormat_Uncompressed = "EcPointFormat_Uncompressed"
+    show EcPointFormat_AnsiX962_compressed_prime = "EcPointFormat_AnsiX962_compressed_prime"
+    show EcPointFormat_AnsiX962_compressed_char2 = "EcPointFormat_AnsiX962_compressed_char2"
+    show (EcPointFormat x) = "EcPointFormat " ++ show x
+{- FOURMOLU_ENABLE -}
+
+-- on decode, filter all unknown formats
+instance Extension EcPointFormatsSupported where
+    extensionID _ = EID_EcPointFormats
+    extensionEncode (EcPointFormatsSupported formats) = runPut $ putWords8 $ map fromEcPointFormat formats
+    extensionDecode MsgTClientHello = decodeEcPointFormatsSupported
+    extensionDecode MsgTServerHello = decodeEcPointFormatsSupported
+    extensionDecode _ = error "extensionDecode: EcPointFormatsSupported"
+
+decodeEcPointFormatsSupported :: ByteString -> Maybe EcPointFormatsSupported
+decodeEcPointFormatsSupported =
+    runGetMaybe (EcPointFormatsSupported . map EcPointFormat <$> getWords8)
+
+------------------------------------------------------------
+
+newtype SignatureAlgorithms = SignatureAlgorithms [HashAndSignatureAlgorithm]
+    deriving (Show, Eq)
+
+instance Extension SignatureAlgorithms where
+    extensionID _ = EID_SignatureAlgorithms
+    extensionEncode (SignatureAlgorithms algs) =
+        runPut $
+            putWord16 (fromIntegral (length algs * 2))
+                >> mapM_ putSignatureHashAlgorithm algs
+    extensionDecode MsgTClientHello = decodeSignatureAlgorithms
+    extensionDecode MsgTCertificateRequest = decodeSignatureAlgorithms
+    extensionDecode _ = error "extensionDecode: SignatureAlgorithms"
+
+decodeSignatureAlgorithms :: ByteString -> Maybe SignatureAlgorithms
+decodeSignatureAlgorithms = runGetMaybe $ do
+    len <- getWord16
+    sas <-
+        getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))
+    leftoverLen <- remaining
+    when (leftoverLen /= 0) $ fail "decodeSignatureAlgorithms: broken length"
+    when (null sas) $ fail "signature algorithms are empty"
+    return $ SignatureAlgorithms sas
+
+------------------------------------------------------------
+
+newtype HeartBeat = HeartBeat HeartBeatMode deriving (Show, Eq)
+
+newtype HeartBeatMode = HeartBeatMode {fromHeartBeatMode :: Word8}
+    deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern HeartBeat_PeerAllowedToSend    :: HeartBeatMode
+pattern HeartBeat_PeerAllowedToSend     = HeartBeatMode 1
+pattern HeartBeat_PeerNotAllowedToSend :: HeartBeatMode
+pattern HeartBeat_PeerNotAllowedToSend  = HeartBeatMode 2
+
+instance Show HeartBeatMode where
+    show HeartBeat_PeerAllowedToSend    = "HeartBeat_PeerAllowedToSend"
+    show HeartBeat_PeerNotAllowedToSend = "HeartBeat_PeerNotAllowedToSend"
+    show (HeartBeatMode x)              = "HeartBeatMode " ++ show x
+{- FOURMOLU_ENABLE -}
+
+instance Extension HeartBeat where
+    extensionID _ = EID_Heartbeat
+    extensionEncode (HeartBeat mode) = runPut $ putWord8 $ fromHeartBeatMode mode
+    extensionDecode MsgTClientHello = decodeHeartBeat
+    extensionDecode MsgTServerHello = decodeHeartBeat
+    extensionDecode _ = error "extensionDecode: HeartBeat"
+
+decodeHeartBeat :: ByteString -> Maybe HeartBeat
+decodeHeartBeat = runGetMaybe $ HeartBeat . HeartBeatMode <$> getWord8
+
+------------------------------------------------------------
+
+-- | Application Layer Protocol Negotiation (ALPN)
+newtype ApplicationLayerProtocolNegotiation
+    = ApplicationLayerProtocolNegotiation [ByteString]
+    deriving (Show, Eq)
+
+instance Extension ApplicationLayerProtocolNegotiation where
+    extensionID _ = EID_ApplicationLayerProtocolNegotiation
+    extensionEncode (ApplicationLayerProtocolNegotiation bytes) =
+        runPut $ putOpaque16 $ runPut $ mapM_ putOpaque8 bytes
+    extensionDecode MsgTClientHello = decodeApplicationLayerProtocolNegotiation
+    extensionDecode MsgTServerHello = decodeApplicationLayerProtocolNegotiation
+    extensionDecode MsgTEncryptedExtensions = decodeApplicationLayerProtocolNegotiation
+    extensionDecode _ = error "extensionDecode: ApplicationLayerProtocolNegotiation"
+
+decodeApplicationLayerProtocolNegotiation
+    :: ByteString -> Maybe ApplicationLayerProtocolNegotiation
+decodeApplicationLayerProtocolNegotiation = runGetMaybe $ do
+    len <- getWord16
+    ApplicationLayerProtocolNegotiation <$> getList (fromIntegral len) getALPN
+  where
+    getALPN = do
+        alpnParsed <- getOpaque8
+        let alpn = B.copy alpnParsed
+        return (B.length alpn + 1, alpn)
+
+------------------------------------------------------------
+
+-- | Extended Main Secret
+data ExtendedMainSecret = ExtendedMainSecret deriving (Show, Eq)
+
+instance Extension ExtendedMainSecret where
+    extensionID _ = EID_ExtendedMainSecret
+    extensionEncode ExtendedMainSecret = B.empty
+    extensionDecode MsgTClientHello "" = Just ExtendedMainSecret
+    extensionDecode MsgTServerHello "" = Just ExtendedMainSecret
+    extensionDecode _ _ = error "extensionDecode: ExtendedMainSecret"
+
+------------------------------------------------------------
+
+newtype CertificateCompressionAlgorithm
+    = CertificateCompressionAlgorithm Word16
+    deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern CCA_Zlib   :: CertificateCompressionAlgorithm
+pattern CCA_Zlib    = CertificateCompressionAlgorithm 1
+pattern CCA_Brotli :: CertificateCompressionAlgorithm
+pattern CCA_Brotli  = CertificateCompressionAlgorithm 2
+pattern CCA_Zstd   :: CertificateCompressionAlgorithm
+pattern CCA_Zstd    = CertificateCompressionAlgorithm 3
+
+instance Show CertificateCompressionAlgorithm where
+    show CCA_Zlib   = "zlib"
+    show CCA_Brotli = "brotli"
+    show CCA_Zstd   = "zstd"
+    show (CertificateCompressionAlgorithm n) = "CertificateCompressionAlgorithm " ++ show n
+{- FOURMOLU_ENABLE -}
+
+newtype CompressCertificate = CompressCertificate [CertificateCompressionAlgorithm]
+    deriving (Show, Eq)
+
+instance Extension CompressCertificate where
+    extensionID _ = EID_CompressCertificate
+    extensionEncode (CompressCertificate cs) = runPut $ do
+        putWord8 $ fromIntegral (length cs * 2)
+        mapM_ putCCA cs
+      where
+        putCCA (CertificateCompressionAlgorithm n) = putWord16 n
+    extensionDecode _ = decodeCompressCertificate
+
+decodeCompressCertificate :: ByteString -> Maybe CompressCertificate
+decodeCompressCertificate = runGetMaybe $ do
+    len <- fromIntegral <$> getWord8
+    cs <- getList len getCCA
+    when (null cs) $ fail "empty list of CertificateCompressionAlgorithm"
+    leftoverLen <- remaining
+    when (leftoverLen /= 0) $ fail "decodeCompressCertificate: broken length"
+    return $ CompressCertificate cs
+  where
+    getCCA = do
+        cca <- CertificateCompressionAlgorithm <$> getWord16
+        return (2, cca)
+
+------------------------------------------------------------
+
+newtype RecordSizeLimit = RecordSizeLimit Word16 deriving (Eq, Show)
+
+instance Extension RecordSizeLimit where
+    extensionID _ = EID_RecordSizeLimit
+    extensionEncode (RecordSizeLimit n) = runPut $ putWord16 n
+    extensionDecode _ = decodeRecordSizeLimit
+
+decodeRecordSizeLimit :: ByteString -> Maybe RecordSizeLimit
+decodeRecordSizeLimit = runGetMaybe $ do
+    r <- RecordSizeLimit <$> getWord16
+    leftoverLen <- remaining
+    when (leftoverLen /= 0) $ fail "decodeRecordSizeLimit: broken length"
+    return r
+
+------------------------------------------------------------
+
+newtype SessionTicket = SessionTicket Ticket
+    deriving (Show, Eq)
+
+-- https://datatracker.ietf.org/doc/html/rfc5077#appendix-A
+instance Extension SessionTicket where
+    extensionID _ = EID_SessionTicket
+    extensionEncode (SessionTicket ticket) = runPut $ putBytes ticket
+    extensionDecode MsgTClientHello = decodeSessionTicket
+    extensionDecode MsgTServerHello = decodeSessionTicket
+    extensionDecode _ = error "extensionDecode: SessionTicket"
+
+decodeSessionTicket :: ByteString -> Maybe SessionTicket
+decodeSessionTicket = runGetMaybe $ SessionTicket <$> (remaining >>= getBytes)
+
+------------------------------------------------------------
+
+data PskIdentity = PskIdentity ByteString Word32 deriving (Eq)
+
+instance Show PskIdentity where
+    show (PskIdentity bs n) = "PskId " ++ showBytesHex bs ++ " " ++ show n
+
+data PreSharedKey
+    = PreSharedKeyClientHello [PskIdentity] [ByteString]
+    | PreSharedKeyServerHello Int
+    deriving (Eq)
+
+instance Show PreSharedKey where
+    show (PreSharedKeyClientHello ids bndrs) =
+        "PreSharedKey "
+            ++ show ids
+            ++ " "
+            ++ "["
+            ++ intercalate ", " (map showBytesHex bndrs)
+            ++ "]"
+    show (PreSharedKeyServerHello n) = "PreSharedKey " ++ show n
+
+instance Extension PreSharedKey where
+    extensionID _ = EID_PreSharedKey
+    extensionEncode (PreSharedKeyClientHello ids bds) = runPut $ do
+        putOpaque16 $ runPut (mapM_ putIdentity ids)
+        putOpaque16 $ runPut (mapM_ putBinder bds)
+      where
+        putIdentity (PskIdentity bs w) = do
+            putOpaque16 bs
+            putWord32 w
+        putBinder = putOpaque8
+    extensionEncode (PreSharedKeyServerHello w16) =
+        runPut $
+            putWord16 $
+                fromIntegral w16
+    extensionDecode MsgTClientHello = decodePreSharedKeyClientHello
+    extensionDecode MsgTServerHello = decodePreSharedKeyServerHello
+    extensionDecode _ = error "extensionDecode: PreShareKey"
+
+decodePreSharedKeyClientHello :: ByteString -> Maybe PreSharedKey
+decodePreSharedKeyClientHello = runGetMaybe $ do
+    len1 <- fromIntegral <$> getWord16
+    identities <- getList len1 getIdentity
+    len2 <- fromIntegral <$> getWord16
+    binders <- getList len2 getBinder
+    return $ PreSharedKeyClientHello identities binders
+  where
+    getIdentity = do
+        identity <- getOpaque16
+        age <- getWord32
+        let len = 2 + B.length identity + 4
+        return (len, PskIdentity identity age)
+    getBinder = do
+        l <- fromIntegral <$> getWord8
+        binder <- getBytes l
+        let len = l + 1
+        return (len, binder)
+
+decodePreSharedKeyServerHello :: ByteString -> Maybe PreSharedKey
+decodePreSharedKeyServerHello =
+    runGetMaybe $
+        PreSharedKeyServerHello . fromIntegral <$> getWord16
+
+decodePreSharedKey :: ByteString -> Maybe PreSharedKey
+decodePreSharedKey bs =
+    decodePreSharedKeyClientHello bs
+        <|> decodePreSharedKeyServerHello bs
+
+------------------------------------------------------------
+
+newtype EarlyDataIndication = EarlyDataIndication (Maybe Word32)
+    deriving (Eq, Show)
+
+instance Extension EarlyDataIndication where
+    extensionID _ = EID_EarlyData
+    extensionEncode (EarlyDataIndication Nothing) = runPut $ putBytes B.empty
+    extensionEncode (EarlyDataIndication (Just w32)) = runPut $ putWord32 w32
+    extensionDecode MsgTClientHello = return $ Just (EarlyDataIndication Nothing)
+    extensionDecode MsgTEncryptedExtensions = return $ Just (EarlyDataIndication Nothing)
+    extensionDecode MsgTNewSessionTicket =
+        runGetMaybe $
+            EarlyDataIndication . Just <$> getWord32
+    extensionDecode _ = error "extensionDecode: EarlyDataIndication"
+
+------------------------------------------------------------
+
+data SupportedVersions
+    = SupportedVersionsClientHello [Version]
+    | SupportedVersionsServerHello Version
+    deriving (Eq)
+
+instance Show SupportedVersions where
+    show (SupportedVersionsClientHello vers) = "Versions " ++ show vers
+    show (SupportedVersionsServerHello ver) = "Versions " ++ show ver
+
+instance Extension SupportedVersions where
+    extensionID _ = EID_SupportedVersions
+    extensionEncode (SupportedVersionsClientHello vers) = runPut $ do
+        putWord8 (fromIntegral (length vers * 2))
+        mapM_ putBinaryVersion vers
+    extensionEncode (SupportedVersionsServerHello ver) =
+        runPut $
+            putBinaryVersion ver
+    extensionDecode MsgTClientHello = decodeSupportedVersionsClientHello
+    extensionDecode MsgTServerHello = decodeSupportedVersionsServerHello
+    extensionDecode _ = error "extensionDecode: SupportedVersionsServerHello"
+
+decodeSupportedVersionsClientHello :: ByteString -> Maybe SupportedVersions
+decodeSupportedVersionsClientHello = runGetMaybe $ do
+    len <- fromIntegral <$> getWord8
+    SupportedVersionsClientHello <$> getList len getVer
+  where
+    getVer = do
+        ver <- getBinaryVersion
+        return (2, ver)
+
+decodeSupportedVersionsServerHello :: ByteString -> Maybe SupportedVersions
+decodeSupportedVersionsServerHello =
+    runGetMaybe (SupportedVersionsServerHello <$> getBinaryVersion)
+
+decodeSupportedVersions :: ByteString -> Maybe SupportedVersions
+decodeSupportedVersions bs =
+    decodeSupportedVersionsClientHello bs
+        <|> decodeSupportedVersionsServerHello bs
+
+------------------------------------------------------------
+
+newtype Cookie = Cookie ByteString deriving (Eq, Show)
+
+instance Extension Cookie where
+    extensionID _ = EID_Cookie
+    extensionEncode (Cookie opaque) = runPut $ putOpaque16 opaque
+    extensionDecode MsgTServerHello = runGetMaybe (Cookie <$> getOpaque16)
+    extensionDecode _ = error "extensionDecode: Cookie"
+
+------------------------------------------------------------
+
+newtype PskKexMode = PskKexMode {fromPskKexMode :: Word8} deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern PSK_KE     :: PskKexMode
+pattern PSK_KE      = PskKexMode 0
+pattern PSK_DHE_KE :: PskKexMode
+pattern PSK_DHE_KE  = PskKexMode 1
+
+instance Show PskKexMode where
+    show PSK_KE     = "PSK_KE"
+    show PSK_DHE_KE = "PSK_DHE_KE"
+    show (PskKexMode x) = "PskKexMode " ++ show x
+{- FOURMOLU_ENABLE -}
+
+newtype PskKeyExchangeModes = PskKeyExchangeModes [PskKexMode]
+    deriving (Eq, Show)
+
+instance Extension PskKeyExchangeModes where
+    extensionID _ = EID_PskKeyExchangeModes
+    extensionEncode (PskKeyExchangeModes pkms) =
+        runPut $
+            putWords8 $
+                map fromPskKexMode pkms
+    extensionDecode MsgTClientHello = decodePskKeyExchangeModes
+    extensionDecode _ = error "extensionDecode: PskKeyExchangeModes"
+
+decodePskKeyExchangeModes :: ByteString -> Maybe PskKeyExchangeModes
+decodePskKeyExchangeModes =
+    runGetMaybe $
+        PskKeyExchangeModes . map PskKexMode <$> getWords8
+
+------------------------------------------------------------
+
+newtype CertificateAuthorities = CertificateAuthorities [DistinguishedName]
+    deriving (Eq, Show)
+
+instance Extension CertificateAuthorities where
+    extensionID _ = EID_CertificateAuthorities
+    extensionEncode (CertificateAuthorities names) =
+        runPut $
+            putDNames names
+    extensionDecode MsgTClientHello = decodeCertificateAuthorities
+    extensionDecode MsgTCertificateRequest = decodeCertificateAuthorities
+    extensionDecode _ = error "extensionDecode: CertificateAuthorities"
+
+decodeCertificateAuthorities :: ByteString -> Maybe CertificateAuthorities
+decodeCertificateAuthorities =
+    runGetMaybe (CertificateAuthorities <$> getDNames)
+
+------------------------------------------------------------
+
+data PostHandshakeAuth = PostHandshakeAuth deriving (Show, Eq)
+
+instance Extension PostHandshakeAuth where
+    extensionID _ = EID_PostHandshakeAuth
+    extensionEncode _ = B.empty
+    extensionDecode MsgTClientHello = runGetMaybe $ return PostHandshakeAuth
+    extensionDecode _ = error "extensionDecode: PostHandshakeAuth"
+
+------------------------------------------------------------
+
+newtype SignatureAlgorithmsCert = SignatureAlgorithmsCert [HashAndSignatureAlgorithm]
+    deriving (Show, Eq)
+
+instance Extension SignatureAlgorithmsCert where
+    extensionID _ = EID_SignatureAlgorithmsCert
+    extensionEncode (SignatureAlgorithmsCert algs) =
+        runPut $
+            putWord16 (fromIntegral (length algs * 2))
+                >> mapM_ putSignatureHashAlgorithm algs
+    extensionDecode MsgTClientHello = decodeSignatureAlgorithmsCert
+    extensionDecode MsgTCertificateRequest = decodeSignatureAlgorithmsCert
+    extensionDecode _ = error "extensionDecode: SignatureAlgorithmsCert"
+
+decodeSignatureAlgorithmsCert :: ByteString -> Maybe SignatureAlgorithmsCert
+decodeSignatureAlgorithmsCert = runGetMaybe $ do
+    len <- getWord16
+    SignatureAlgorithmsCert
+        <$> getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))
+
+------------------------------------------------------------
+
+data KeyShareEntry = KeyShareEntry
+    { keyShareEntryGroup :: Group
+    , keyShareEntryKeyExchange :: ByteString
+    }
+    deriving (Eq)
+
+instance Show KeyShareEntry where
+    show kse = show $ keyShareEntryGroup kse
+
+getKeyShareEntry :: Get (Int, Maybe KeyShareEntry)
+getKeyShareEntry = do
+    grp <- Group <$> getWord16
+    l <- fromIntegral <$> getWord16
+    key <- getBytes l
+    let len = l + 4
+    return (len, Just $ KeyShareEntry grp key)
+
+putKeyShareEntry :: KeyShareEntry -> Put
+putKeyShareEntry (KeyShareEntry (Group grp) key) = do
+    putWord16 grp
+    putWord16 $ fromIntegral $ B.length key
+    putBytes key
+
+data KeyShare
+    = KeyShareClientHello [KeyShareEntry]
+    | KeyShareServerHello KeyShareEntry
+    | KeyShareHRR Group
+    deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+instance Show KeyShare where
+    show (KeyShareClientHello kses) = "KeyShare " ++ show kses
+    show (KeyShareServerHello kse)  = "KeyShare " ++ show kse
+    show (KeyShareHRR g)            = "KeyShareHRR " ++ show g
+{- FOURMOLU_ENABLE -}
+
+instance Extension KeyShare where
+    extensionID _ = EID_KeyShare
+    extensionEncode (KeyShareClientHello kses) = runPut $ do
+        let len = sum [B.length key + 4 | KeyShareEntry _ key <- kses]
+        putWord16 $ fromIntegral len
+        mapM_ putKeyShareEntry kses
+    extensionEncode (KeyShareServerHello kse) = runPut $ putKeyShareEntry kse
+    extensionEncode (KeyShareHRR (Group grp)) = runPut $ putWord16 grp
+    extensionDecode MsgTClientHello = decodeKeyShareClientHello
+    extensionDecode MsgTServerHello = decodeKeyShareServerHello
+    extensionDecode MsgTHelloRetryRequest = decodeKeyShareHRR
+    extensionDecode _ = error "extensionDecode: KeyShare"
+
+decodeKeyShareClientHello :: ByteString -> Maybe KeyShare
+decodeKeyShareClientHello = runGetMaybe $ do
+    len <- fromIntegral <$> getWord16
+    --      len == 0 allows for HRR
+    grps <- getList len getKeyShareEntry
+    return $ KeyShareClientHello $ catMaybes grps
+
+decodeKeyShareServerHello :: ByteString -> Maybe KeyShare
+decodeKeyShareServerHello = runGetMaybe $ do
+    (_, ment) <- getKeyShareEntry
+    case ment of
+        Nothing -> fail "decoding KeyShare for ServerHello"
+        Just ent -> return $ KeyShareServerHello ent
+
+decodeKeyShareHRR :: ByteString -> Maybe KeyShare
+decodeKeyShareHRR =
+    runGetMaybe $
+        KeyShareHRR . Group <$> getWord16
+
+decodeKeyShare :: ByteString -> Maybe KeyShare
+decodeKeyShare bs =
+    decodeKeyShareClientHello bs
+        <|> decodeKeyShareServerHello bs
+        <|> decodeKeyShareHRR bs
+
+------------------------------------------------------------
+
+newtype EchOuterExtensions = EchOuterExtensions [ExtensionID]
+    deriving (Eq, Show)
+
+instance Extension EchOuterExtensions where
+    extensionID _ = EID_EchOuterExtensions
+    extensionEncode (EchOuterExtensions ids) = runPut $ do
+        putWord8 $ fromIntegral (length ids * 2)
+        mapM_ (putWord16 . fromExtensionID) ids
+    extensionDecode MsgTClientHello = decodeEchOuterExtensions
+    extensionDecode _ = error "extensionDecode: EchOuterExtensions"
+
+decodeEchOuterExtensions :: ByteString -> Maybe EchOuterExtensions
+decodeEchOuterExtensions = runGetMaybe $ do
+    len <- fromIntegral <$> getWord8
+    eids <- getList len $ do
+        eid <- ExtensionID <$> getWord16
+        return (2, eid)
+    return $ EchOuterExtensions eids
+
+------------------------------------------------------------
+
+-- | Encrypted Client Hello
+data EncryptedClientHello
+    = ECHClientHelloInner
+    | ECHClientHelloOuter
+        { echCipherSuite :: (KDF_ID, AEAD_ID)
+        , echConfigId :: ConfigId
+        , echEnc :: EncodedPublicKey
+        , echPayload :: ByteString
+        }
+    | ECHEncryptedExtensions ECHConfigList
+    | ECHHelloRetryRequest ByteString
+    deriving (Eq)
+
+instance Show EncryptedClientHello where
+    show ECHClientHelloInner = "ECHClientHelloInner"
+    show ECHClientHelloOuter{..} =
+        "ECHClientHelloOuter {"
+            ++ show (fst echCipherSuite)
+            ++ " "
+            ++ show (snd echCipherSuite)
+            ++ " "
+            ++ show echConfigId
+            ++ " "
+            ++ showBytesHex enc
+            ++ " "
+            ++ showBytesHex echPayload
+            ++ "}"
+      where
+        EncodedPublicKey enc = echEnc
+    show (ECHEncryptedExtensions cnflst) = "ECHEncryptedExtensions " ++ show cnflst
+    show (ECHHelloRetryRequest cnfm) = "ECHHelloRetryRequest " ++ showBytesHex cnfm
+
+instance Extension EncryptedClientHello where
+    extensionID _ = EID_EncryptedClientHello
+    extensionEncode ECHClientHelloInner = runPut $ putWord8 1
+    extensionEncode ECHClientHelloOuter{..} = runPut $ do
+        putWord8 0
+        let (kdfid, aeadid) = echCipherSuite
+        putWord16 $ fromKDF_ID kdfid
+        putWord16 $ fromAEAD_ID aeadid
+        putWord8 echConfigId
+        let EncodedPublicKey enc = echEnc
+        putOpaque16 enc
+        putOpaque16 echPayload
+    extensionEncode (ECHEncryptedExtensions cnflist) = encodeECHConfigList cnflist
+    extensionEncode (ECHHelloRetryRequest cnfm) = runPut $ putBytes cnfm
+    extensionDecode MsgTClientHello = decodeECHClientHello
+    extensionDecode MsgTEncryptedExtensions = decodeECHEncryptedExtensions
+    extensionDecode MsgTHelloRetryRequest = decodeECHHelloRetryRequest
+    extensionDecode _ = error "extensionDecode: EncryptedClientHello"
+
+decodeECH :: ByteString -> Maybe EncryptedClientHello
+decodeECH bs =
+    decodeECHClientHello bs
+        <|> decodeECHEncryptedExtensions bs
+        <|> decodeECHHelloRetryRequest bs
+
+decodeECHClientHello :: ByteString -> Maybe EncryptedClientHello
+decodeECHClientHello = runGetMaybe $ do
+    typ <- getWord8
+    if typ == 1
+        then return ECHClientHelloInner
+        else do
+            kdfid <- KDF_ID <$> getWord16
+            aeadid <- AEAD_ID <$> getWord16
+            cnfid <- getWord8
+            enc <- EncodedPublicKey <$> getOpaque16
+            payload <- getOpaque16
+            return $
+                ECHClientHelloOuter
+                    { echCipherSuite = (kdfid, aeadid)
+                    , echConfigId = cnfid
+                    , echEnc = enc
+                    , echPayload = payload
+                    }
+
+decodeECHEncryptedExtensions :: ByteString -> Maybe EncryptedClientHello
+decodeECHEncryptedExtensions bs =
+    ECHEncryptedExtensions <$> decodeECHConfigList bs
+
+decodeECHHelloRetryRequest :: ByteString -> Maybe EncryptedClientHello
+decodeECHHelloRetryRequest = runGetMaybe $ do
+    ECHHelloRetryRequest <$> getBytes 8
+
+------------------------------------------------------------
+
+-- | Secure Renegotiation
+data SecureRenegotiation = SecureRenegotiation ByteString ByteString
+    deriving (Show, Eq)
+
+instance Extension SecureRenegotiation where
+    extensionID _ = EID_SecureRenegotiation
+    extensionEncode (SecureRenegotiation cvd svd) =
+        runPut $ putOpaque8 (cvd `B.append` svd)
+    extensionDecode MsgTClientHello = runGetMaybe $ do
+        opaque <- getOpaque8
+        return $ SecureRenegotiation opaque ""
+    extensionDecode MsgTServerHello = runGetMaybe $ do
+        opaque <- getOpaque8
+        let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque
+        return $ SecureRenegotiation cvd svd
+    extensionDecode _ = error "extensionDecode: SecureRenegotiation"
diff --git a/Network/TLS/Extension.hs-boot b/Network/TLS/Extension.hs-boot
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Extension.hs-boot
@@ -0,0 +1,22 @@
+-- This is a breaker for cyclic imports:
+--
+-- - Network.TLS.Extension imports Network.TLS.Struct
+-- - Network.TLS.Extension imports Network.TLS.Packet
+--
+-- - Network.TLS.Struct imports Network.TLS.Extension
+--
+-- - Network.TLS.Packet imports Network.TLS.Struct
+--
+-- Originally, ExtensionRaw was defined in Network.TLS.Struct and no
+-- cyclic imports exist. It is moved into Network.TLS.Extension for
+-- pretty-printing, so the cyclic imports happen.
+module Network.TLS.Extension where
+
+import Data.ByteString
+import Data.Word
+
+data ExtensionRaw = ExtensionRaw ExtensionID ByteString
+instance Eq ExtensionRaw
+instance Show ExtensionRaw
+
+newtype ExtensionID = ExtensionID {fromExtensionID :: Word16}
diff --git a/Network/TLS/Extra.hs b/Network/TLS/Extra.hs
--- a/Network/TLS/Extra.hs
+++ b/Network/TLS/Extra.hs
@@ -1,13 +1,8 @@
--- |
--- Module      : Network.TLS.Extra
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- default values and ciphers
-module Network.TLS.Extra
-    ( module Network.TLS.Extra.Cipher
-    ) where
+-- | Default values and ciphers
+module Network.TLS.Extra (
+    module Network.TLS.Extra.Cipher,
+    module Network.TLS.Extra.FFDHE,
+) where
 
 import Network.TLS.Extra.Cipher
+import Network.TLS.Extra.FFDHE
diff --git a/Network/TLS/Extra/Cipher.hs b/Network/TLS/Extra/Cipher.hs
--- a/Network/TLS/Extra/Cipher.hs
+++ b/Network/TLS/Extra/Cipher.hs
@@ -1,432 +1,808 @@
--- |
--- Module      : Network.TLS.Extra.Cipher
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE PackageImports #-}
-module Network.TLS.Extra.Cipher
-    (
-    -- * cipher suite
-      ciphersuite_all
-    , ciphersuite_medium
-    , ciphersuite_strong
-    , ciphersuite_unencrypted
-    , ciphersuite_dhe_rsa
-    , ciphersuite_dhe_dss
-    -- * individual ciphers
-    , cipher_null_SHA1
-    , cipher_null_MD5
-    , cipher_RC4_128_MD5
-    , cipher_RC4_128_SHA1
-    , cipher_AES128_SHA1
-    , cipher_AES256_SHA1
-    , cipher_AES128_SHA256
-    , cipher_AES256_SHA256
-    , cipher_RSA_3DES_EDE_CBC_SHA1
-    , cipher_DHE_RSA_AES128_SHA1
-    , cipher_DHE_RSA_AES256_SHA1
-    , cipher_DHE_RSA_AES128_SHA256
-    , cipher_DHE_RSA_AES256_SHA256
-    , cipher_DHE_DSS_AES128_SHA1
-    , cipher_DHE_DSS_AES256_SHA1
-    , cipher_DHE_DSS_RC4_SHA1
-    ) where
-
-import qualified Data.ByteString as B
-
-import Network.TLS (Version(..))
-import Network.TLS.Cipher
-import qualified "cipher-rc4" Crypto.Cipher.RC4 as RC4
-
-import qualified Crypto.Hash.SHA256 as SHA256
-import qualified Crypto.Hash.SHA1 as SHA1
-import qualified Crypto.Hash.MD5 as MD5
-
-import qualified "cipher-aes" Crypto.Cipher.AES as AES
-import Crypto.Cipher.TripleDES
-import Crypto.Cipher.Types (makeKey, makeIV, cipherInit, cbcEncrypt, cbcDecrypt)
-import qualified Crypto.Cipher.Types as T
-
-aes_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString
-aes_cbc_encrypt key iv d = AES.encryptCBC (AES.initAES key) iv d
-
-aes_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString
-aes_cbc_decrypt key iv d = AES.decryptCBC (AES.initAES key) iv d
-
-aes128_cbc_encrypt
-  , aes128_cbc_decrypt
-  , aes256_cbc_encrypt
-  , aes256_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString
-aes128_cbc_encrypt = aes_cbc_encrypt
-aes128_cbc_decrypt = aes_cbc_decrypt
-aes256_cbc_encrypt = aes_cbc_encrypt
-aes256_cbc_decrypt = aes_cbc_decrypt
-
-tripledes_ede_cbc_encrypt :: Key -> IV -> B.ByteString -> B.ByteString
-tripledes_ede_cbc_encrypt key iv bs =
-    cbcEncrypt (cipherInit $ tripledes_key key) (tripledes_iv iv) bs
-
-tripledes_ede_cbc_decrypt :: Key -> IV -> B.ByteString -> B.ByteString
-tripledes_ede_cbc_decrypt key iv bs =
-    cbcDecrypt (cipherInit $ tripledes_key key) (tripledes_iv iv) bs
-
-tripledes_key :: Key -> T.Key DES_EDE3
-tripledes_key key = either (\ke -> error ("tripledes cipher key internal error: " ++ show ke)) id $ makeKey key
-
-tripledes_iv :: IV -> T.IV DES_EDE3
-tripledes_iv iv = maybe (error "tripledes cipher iv internal error") id $ makeIV iv
-
-toIV :: RC4.Ctx -> IV
-toIV (RC4.Ctx ctx) = ctx
-
-toCtx :: IV -> RC4.Ctx
-toCtx iv = RC4.Ctx iv
-
-initF_rc4 :: Key -> IV
-initF_rc4 key     = toIV $ RC4.initCtx key
-
-encryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV)
-encryptF_rc4 iv d = (\(ctx, e) -> (e, toIV ctx)) $ RC4.combine (toCtx iv) d
-
-decryptF_rc4 :: IV -> B.ByteString -> (B.ByteString, IV)
-decryptF_rc4 iv e = (\(ctx, d) -> (d, toIV ctx)) $ RC4.combine (toCtx iv) e
-
-
--- | all encrypted ciphers supported ordered from strong to weak.
--- this choice of ciphersuite should satisfy most normal need
-ciphersuite_all :: [Cipher]
-ciphersuite_all =
-    [ cipher_DHE_RSA_AES256_SHA256, cipher_DHE_RSA_AES128_SHA256
-    , cipher_DHE_RSA_AES256_SHA1, cipher_DHE_RSA_AES128_SHA1
-    , cipher_DHE_DSS_AES256_SHA1, cipher_DHE_DSS_AES128_SHA1
-    , cipher_AES128_SHA256, cipher_AES256_SHA256
-    , cipher_AES128_SHA1,   cipher_AES256_SHA1
-    , cipher_DHE_DSS_RC4_SHA1, cipher_RC4_128_SHA1,  cipher_RC4_128_MD5
-    , cipher_RSA_3DES_EDE_CBC_SHA1
-    ]
-
--- | list of medium ciphers.
-ciphersuite_medium :: [Cipher]
-ciphersuite_medium = [cipher_RC4_128_MD5, cipher_RC4_128_SHA1, cipher_AES128_SHA1, cipher_AES256_SHA1]
-
--- | the strongest ciphers supported.
-ciphersuite_strong :: [Cipher]
-ciphersuite_strong = [cipher_DHE_RSA_AES256_SHA256, cipher_AES256_SHA256, cipher_AES256_SHA1]
-
--- | DHE-RSA cipher suite
-ciphersuite_dhe_rsa :: [Cipher]
-ciphersuite_dhe_rsa = [cipher_DHE_RSA_AES256_SHA256, cipher_DHE_RSA_AES128_SHA256
-                      , cipher_DHE_RSA_AES256_SHA1, cipher_DHE_RSA_AES128_SHA1]
-
-ciphersuite_dhe_dss :: [Cipher]
-ciphersuite_dhe_dss = [cipher_DHE_DSS_AES256_SHA1, cipher_DHE_DSS_AES128_SHA1, cipher_DHE_DSS_RC4_SHA1]
-
--- | all unencrypted ciphers, do not use on insecure network.
-ciphersuite_unencrypted :: [Cipher]
-ciphersuite_unencrypted = [cipher_null_MD5, cipher_null_SHA1]
-
-bulk_null, bulk_rc4, bulk_aes128, bulk_aes256, bulk_tripledes_ede :: Bulk
-bulk_null = Bulk
-    { bulkName         = "null"
-    , bulkKeySize      = 0
-    , bulkIVSize       = 0
-    , bulkBlockSize    = 0
-    , bulkF            = BulkStreamF (const B.empty) streamId streamId
-    }
-    where streamId = \iv b -> (b,iv)
-
-bulk_rc4 = Bulk
-    { bulkName         = "RC4-128"
-    , bulkKeySize      = 16
-    , bulkIVSize       = 0
-    , bulkBlockSize    = 0
-    , bulkF            = BulkStreamF initF_rc4 encryptF_rc4 decryptF_rc4
-    }
-
-bulk_aes128 = Bulk
-    { bulkName         = "AES128"
-    , bulkKeySize      = 16
-    , bulkIVSize       = 16
-    , bulkBlockSize    = 16
-    , bulkF            = BulkBlockF aes128_cbc_encrypt aes128_cbc_decrypt
-    }
-
-bulk_aes256 = Bulk
-    { bulkName         = "AES256"
-    , bulkKeySize      = 32
-    , bulkIVSize       = 16
-    , bulkBlockSize    = 16
-    , bulkF            = BulkBlockF aes256_cbc_encrypt aes256_cbc_decrypt
-    }
-
-bulk_tripledes_ede = Bulk
-    { bulkName      = "3DES-EDE-CBC"
-    , bulkKeySize   = 24
-    , bulkIVSize    = 8
-    , bulkBlockSize = 8
-    , bulkF         = BulkBlockF tripledes_ede_cbc_encrypt tripledes_ede_cbc_decrypt
-    }
-
-hash_md5, hash_sha1, hash_sha256 :: Hash
-hash_md5 = Hash
-    { hashName = "MD5"
-    , hashSize = 16
-    , hashF    = MD5.hash
-    }
-
-hash_sha1 = Hash
-    { hashName = "SHA1"
-    , hashSize = 20
-    , hashF    = SHA1.hash
-    }
-
-hash_sha256 = Hash
-    { hashName = "SHA256"
-    , hashSize = 32
-    , hashF    = SHA256.hash
-    }
-
--- | unencrypted cipher using RSA for key exchange and MD5 for digest
-cipher_null_MD5 :: Cipher
-cipher_null_MD5 = Cipher
-    { cipherID           = 0x1
-    , cipherName         = "RSA-null-MD5"
-    , cipherBulk         = bulk_null
-    , cipherHash         = hash_md5
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Nothing
-    }
-
--- | unencrypted cipher using RSA for key exchange and SHA1 for digest
-cipher_null_SHA1 :: Cipher
-cipher_null_SHA1 = Cipher
-    { cipherID           = 0x2
-    , cipherName         = "RSA-null-SHA1"
-    , cipherBulk         = bulk_null
-    , cipherHash         = hash_sha1
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Nothing
-    }
-
--- | RC4 cipher, RSA key exchange and MD5 for digest
-cipher_RC4_128_MD5 :: Cipher
-cipher_RC4_128_MD5 = Cipher
-    { cipherID           = 0x04
-    , cipherName         = "RSA-rc4-128-md5"
-    , cipherBulk         = bulk_rc4
-    , cipherHash         = hash_md5
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Nothing
-    }
-
--- | RC4 cipher, RSA key exchange and SHA1 for digest
-cipher_RC4_128_SHA1 :: Cipher
-cipher_RC4_128_SHA1 = Cipher
-    { cipherID           = 0x05
-    , cipherName         = "RSA-rc4-128-sha1"
-    , cipherBulk         = bulk_rc4
-    , cipherHash         = hash_sha1
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Nothing
-    }
-
--- | AES cipher (128 bit key), RSA key exchange and SHA1 for digest
-cipher_AES128_SHA1 :: Cipher
-cipher_AES128_SHA1 = Cipher
-    { cipherID           = 0x2f
-    , cipherName         = "RSA-aes128-sha1"
-    , cipherBulk         = bulk_aes128
-    , cipherHash         = hash_sha1
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Just SSL3
-    }
-
--- | AES cipher (256 bit key), RSA key exchange and SHA1 for digest
-cipher_AES256_SHA1 :: Cipher
-cipher_AES256_SHA1 = Cipher
-    { cipherID           = 0x35
-    , cipherName         = "RSA-aes256-sha1"
-    , cipherBulk         = bulk_aes256
-    , cipherHash         = hash_sha1
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Just SSL3
-    }
-
--- | AES cipher (128 bit key), RSA key exchange and SHA256 for digest
-cipher_AES128_SHA256 :: Cipher
-cipher_AES128_SHA256 = Cipher
-    { cipherID           = 0x3c
-    , cipherName         = "RSA-aes128-sha256"
-    , cipherBulk         = bulk_aes128
-    , cipherHash         = hash_sha256
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Just TLS12
-    }
-
--- | AES cipher (256 bit key), RSA key exchange and SHA256 for digest
-cipher_AES256_SHA256 :: Cipher
-cipher_AES256_SHA256 = Cipher
-    { cipherID           = 0x3d
-    , cipherName         = "RSA-aes256-sha256"
-    , cipherBulk         = bulk_aes256
-    , cipherHash         = hash_sha256
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Just TLS12
-    }
-
--- | AES cipher (128 bit key), DHE key exchanged signed by RSA and SHA1 for digest
-cipher_DHE_RSA_AES128_SHA1 :: Cipher
-cipher_DHE_RSA_AES128_SHA1 = Cipher
-    { cipherID           = 0x33
-    , cipherName         = "DHE-RSA-AES128-SHA1"
-    , cipherBulk         = bulk_aes128
-    , cipherHash         = hash_sha1
-    , cipherKeyExchange  = CipherKeyExchange_DHE_RSA
-    , cipherMinVer       = Nothing
-    }
-
--- | AES cipher (256 bit key), DHE key exchanged signed by RSA and SHA1 for digest
-cipher_DHE_RSA_AES256_SHA1 :: Cipher
-cipher_DHE_RSA_AES256_SHA1 = cipher_DHE_RSA_AES128_SHA1
-    { cipherID           = 0x39
-    , cipherName         = "DHE-RSA-AES256-SHA1"
-    , cipherBulk         = bulk_aes256
-    }
-
--- | AES cipher (128 bit key), DHE key exchanged signed by DSA and SHA1 for digest
-cipher_DHE_DSS_AES128_SHA1 :: Cipher
-cipher_DHE_DSS_AES128_SHA1 = Cipher
-    { cipherID           = 0x32
-    , cipherName         = "DHE-DSA-AES128-SHA1"
-    , cipherBulk         = bulk_aes128
-    , cipherHash         = hash_sha1
-    , cipherKeyExchange  = CipherKeyExchange_DHE_DSS
-    , cipherMinVer       = Nothing
-    }
-
--- | AES cipher (256 bit key), DHE key exchanged signed by DSA and SHA1 for digest
-cipher_DHE_DSS_AES256_SHA1 :: Cipher
-cipher_DHE_DSS_AES256_SHA1 = cipher_DHE_DSS_AES128_SHA1
-    { cipherID           = 0x38
-    , cipherName         = "DHE-DSA-AES256-SHA1"
-    , cipherBulk         = bulk_aes256
-    }
-
-cipher_DHE_DSS_RC4_SHA1 :: Cipher
-cipher_DHE_DSS_RC4_SHA1 = cipher_DHE_DSS_AES128_SHA1
-    { cipherID           = 0x66
-    , cipherName         = "DHE-DSA-RC4-SHA1"
-    , cipherBulk         = bulk_rc4
-    }
-
-cipher_DHE_RSA_AES128_SHA256 :: Cipher
-cipher_DHE_RSA_AES128_SHA256 = cipher_DHE_RSA_AES128_SHA1
-    { cipherID           = 0x67
-    , cipherName         = "DHE-RSA-AES128-SHA256"
-    , cipherHash         = hash_sha256
-    , cipherMinVer       = Just TLS12
-    }
-
-cipher_DHE_RSA_AES256_SHA256 :: Cipher
-cipher_DHE_RSA_AES256_SHA256 = cipher_DHE_RSA_AES128_SHA256
-    { cipherID           = 0x6b
-    , cipherName         = "DHE-RSA-AES256-SHA256"
-    , cipherBulk         = bulk_aes256
-    }
-
--- | 3DES cipher (168 bit key), RSA key exchange and SHA1 for digest
-cipher_RSA_3DES_EDE_CBC_SHA1 :: Cipher
-cipher_RSA_3DES_EDE_CBC_SHA1 = Cipher
-    { cipherID           = 0x0a
-    , cipherName         = "RSA-3DES-EDE-CBC-SHA1"
-    , cipherBulk         = bulk_tripledes_ede
-    , cipherHash         = hash_sha1
-    , cipherKeyExchange  = CipherKeyExchange_RSA
-    , cipherMinVer       = Nothing
-    }
-
-
-{-
-TLS 1.0 ciphers definition
-
-CipherSuite TLS_NULL_WITH_NULL_NULL               = { 0x00,0x00 };
-CipherSuite TLS_RSA_WITH_NULL_MD5                 = { 0x00,0x01 };
-CipherSuite TLS_RSA_WITH_NULL_SHA                 = { 0x00,0x02 };
-CipherSuite TLS_RSA_EXPORT_WITH_RC4_40_MD5        = { 0x00,0x03 };
-CipherSuite TLS_RSA_WITH_RC4_128_MD5              = { 0x00,0x04 };
-CipherSuite TLS_RSA_WITH_RC4_128_SHA              = { 0x00,0x05 };
-CipherSuite TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5    = { 0x00,0x06 };
-CipherSuite TLS_RSA_WITH_IDEA_CBC_SHA             = { 0x00,0x07 };
-CipherSuite TLS_RSA_EXPORT_WITH_DES40_CBC_SHA     = { 0x00,0x08 };
-CipherSuite TLS_RSA_WITH_DES_CBC_SHA              = { 0x00,0x09 };
-CipherSuite TLS_RSA_WITH_3DES_EDE_CBC_SHA         = { 0x00,0x0A };
-CipherSuite TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA  = { 0x00,0x0B };
-CipherSuite TLS_DH_DSS_WITH_DES_CBC_SHA           = { 0x00,0x0C };
-CipherSuite TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA      = { 0x00,0x0D };
-CipherSuite TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA  = { 0x00,0x0E };
-CipherSuite TLS_DH_RSA_WITH_DES_CBC_SHA           = { 0x00,0x0F };
-CipherSuite TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA      = { 0x00,0x10 };
-CipherSuite TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x11 };
-CipherSuite TLS_DHE_DSS_WITH_DES_CBC_SHA          = { 0x00,0x12 };
-CipherSuite TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA     = { 0x00,0x13 };
-CipherSuite TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x14 };
-CipherSuite TLS_DHE_RSA_WITH_DES_CBC_SHA          = { 0x00,0x15 };
-CipherSuite TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA     = { 0x00,0x16 };
-CipherSuite TLS_DH_anon_EXPORT_WITH_RC4_40_MD5    = { 0x00,0x17 };
-CipherSuite TLS_DH_anon_WITH_RC4_128_MD5          = { 0x00,0x18 };
-CipherSuite TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x19 };
-CipherSuite TLS_DH_anon_WITH_DES_CBC_SHA          = { 0x00,0x1A };
-CipherSuite TLS_DH_anon_WITH_3DES_EDE_CBC_SHA     = { 0x00,0x1B };
-
-TLS-DHE-RSA-WITH-AES-128-CBC-SHA     {0x00,0x33}
-TLS-DHE-RSA-WITH-AES-256-CBC-SHA     {0x00,0x39}
-TLS-DHE-RSA-WITH-AES-128-CBC-SHA256   {0x00,0x67}
-TLS-DHE-RSA-WITH-AES-256-CBC-SHA256   {0x00,0x6B}
-TLS-DHE-RSA-WITH-AES-128-GCM-SHA256   {0x00,0x9E}
-TLS-DHE-RSA-WITH-AES-256-GCM-SHA384   {0x00,0x9F}
-TLS-DHE-RSA-WITH-CAMELLIA-128-CBC-SHA   {0x00,0x45}
-TLS-DHE-RSA-WITH-CAMELLIA-256-CBC-SHA   {0x00,0x88}
-TLS-DHE-RSA-WITH-CAMELLIA-128-CBC-SHA256      {0x00,0xBE}
-TLS-DHE-RSA-WITH-CAMELLIA-256-CBC-SHA256      {0x00,0xC4}
-TLS-DHE-RSA-WITH-CAMELLIA-128-GCM-SHA256      {0x00,0x7C}
-TLS-DHE-RSA-WITH-CAMELLIA-256-GCM-SHA256      {0x00,0x7D}
-TLS-DHE-RSA-WITH-3DES-EDE-CBC-SHA      {0x00,0x16}
-TLS-DHE-RSA-WITH-DES-CBC-SHA    {0x00,0x15}
-
-TLS-ECDHE-RSA-WITH-AES-128-CBC-SHA     {0xC0,0x13}
-TLS-ECDHE-RSA-WITH-AES-256-CBC-SHA     {0xC0,0x14}
-TLS-ECDHE-RSA-WITH-AES-128-CBC-SHA256   {0xC0,0x27}
-TLS-ECDHE-RSA-WITH-AES-256-CBC-SHA384   {0xC0,0x28}
-TLS-ECDHE-RSA-WITH-AES-128-GCM-SHA256   {0xC0,0x2F}
-TLS-ECDHE-RSA-WITH-AES-256-GCM-SHA384   {0xC0,0x30}
-TLS-ECDHE-RSA-WITH-CAMELLIA-128-CBC-SHA256    {0xC0,0x76}
-TLS-ECDHE-RSA-WITH-CAMELLIA-256-CBC-SHA384    {0xC0,0x77}
-TLS-ECDHE-RSA-WITH-CAMELLIA-128-GCM-SHA256    {0xC0,0x8A}
-TLS-ECDHE-RSA-WITH-CAMELLIA-256-GCM-SHA384    {0xC0,0x8B}
-TLS-ECDHE-RSA-WITH-3DES-EDE-CBC-SHA  {0xC0,0x12}
-TLS-ECDHE-RSA-WITH-RC4-128-SHA    {0xC0,0x11}
-TLS-ECDHE-RSA-WITH-NULL-SHA  {0xC0,0x10}
-
-TLS-PSK-WITH-RC4-128-SHA    {0x00,0x8A}
-TLS-PSK-WITH-3DES-EDE-CBC-SHA      {0x00,0x8B}
-TLS-PSK-WITH-AES-128-CBC-SHA     {0x00,0x8C}
-TLS-PSK-WITH-AES-256-CBC-SHA     {0x00,0x8D}
-TLS-PSK-WITH-AES-128-CBC-SHA256   {0x00,0xAE}
-TLS-PSK-WITH-AES-256-CBC-SHA384   {0x00,0xAF}
-TLS-PSK-WITH-AES-128-GCM-SHA256   {0x00,0xA8}
-TLS-PSK-WITH-AES-256-GCM-SHA384   {0x00,0xA9}
-TLS-PSK-WITH-CAMELLIA-128-CBC-SHA256      {0xC0,0x94}
-TLS-PSK-WITH-CAMELLIA-256-CBC-SHA384      {0xC0,0x95}
-TLS-PSK-WITH-CAMELLIA-128-GCM-SHA256      {0xC0,0x8D}
-TLS-PSK-WITH-CAMELLIA-256-GCM-SHA384      {0xC0,0x8F}
-TLS-PSK-WITH-NULL-SHA     {0x00,0x2C}
-TLS-PSK-WITH-NULL-SHA256      {0x00,0xB4}
-TLS-PSK-WITH-NULL-SHA384      {0x00,0xB5}
-
-best ciphers suite description:
-    <http://www.thesprawl.org/research/tls-and-ssl-cipher-suites/>
-
--}
+module Network.TLS.Extra.Cipher (
+    -- * Cipher suite
+    ciphersuite_default,
+    ciphersuite_default_det,
+    ciphersuite_all,
+    ciphersuite_all_det,
+    ciphersuite_strong,
+    ciphersuite_strong_det,
+    ciphersuite_dhe_rsa,
+
+    -- * Individual ciphers
+
+    -- ** RFC 5288
+    cipher_DHE_RSA_WITH_AES_128_GCM_SHA256,
+    cipher_DHE_RSA_WITH_AES_256_GCM_SHA384,
+
+    -- ** RFC 8446
+    cipher13_AES_128_GCM_SHA256,
+    cipher13_AES_256_GCM_SHA384,
+    cipher13_CHACHA20_POLY1305_SHA256,
+    cipher13_AES_128_CCM_SHA256,
+    cipher13_AES_128_CCM_8_SHA256,
+
+    -- ** RFC 5289
+    cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256,
+    cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384,
+    cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256,
+    cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384,
+
+    -- ** RFC 7251
+    cipher_ECDHE_ECDSA_WITH_AES_128_CCM,
+    cipher_ECDHE_ECDSA_WITH_AES_256_CCM,
+    cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8,
+    cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8,
+
+    -- ** RFC 7905
+    cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256,
+    cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256,
+    cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256,
+
+    -- * Deprecated names
+
+    -- ** RFC 5288
+    cipher_DHE_RSA_AES128GCM_SHA256,
+    cipher_DHE_RSA_AES256GCM_SHA384,
+
+    -- ** RFC 8446
+    cipher_TLS13_AES128GCM_SHA256,
+    cipher_TLS13_AES256GCM_SHA384,
+    cipher_TLS13_CHACHA20POLY1305_SHA256,
+    cipher_TLS13_AES128CCM_SHA256,
+    cipher_TLS13_AES128CCM8_SHA256,
+
+    -- ** RFC 5289
+    cipher_ECDHE_ECDSA_AES128GCM_SHA256,
+    cipher_ECDHE_ECDSA_AES256GCM_SHA384,
+    cipher_ECDHE_RSA_AES128GCM_SHA256,
+    cipher_ECDHE_RSA_AES256GCM_SHA384,
+
+    -- ** RFC 7251
+    cipher_ECDHE_ECDSA_AES128CCM_SHA256,
+    cipher_ECDHE_ECDSA_AES256CCM_SHA256,
+    cipher_ECDHE_ECDSA_AES128CCM8_SHA256,
+    cipher_ECDHE_ECDSA_AES256CCM8_SHA256,
+
+    -- ** RFC 7905
+    cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256,
+    cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256,
+    cipher_DHE_RSA_CHACHA20POLY1305_SHA256,
+) where
+
+import Crypto.Cipher.AES
+import qualified Crypto.Cipher.ChaChaPoly1305 as ChaChaPoly1305
+import Crypto.Cipher.Types hiding (Cipher, cipherName)
+import Crypto.Error
+import qualified Crypto.MAC.Poly1305 as Poly1305
+import Crypto.System.CPU
+import qualified Data.ByteString as B
+import Data.Tuple (swap)
+
+import Network.TLS.Cipher
+import Network.TLS.Imports
+import Network.TLS.Types
+
+----------------------------------------------------------------
+
+-- | All AES and ChaCha20-Poly1305 ciphers supported ordered from strong to
+-- weak.  This choice of ciphersuites should satisfy most normal needs.  For
+-- otherwise strong ciphers we make little distinction between AES128 and
+-- AES256, and list each but the weakest of the AES128 ciphers ahead of the
+-- corresponding AES256 ciphers.
+--
+-- AEAD ciphers with equivalent security properties are ordered based on CPU
+-- hardware-acceleration support.  If this dynamic runtime behavior is not
+-- desired, use 'ciphersuite_default_det' instead.
+ciphersuite_default :: [Cipher]
+ciphersuite_default = ciphersuite_strong
+
+-- | Same as 'ciphersuite_default', but using deterministic preference not
+-- influenced by the CPU.
+ciphersuite_default_det :: [Cipher]
+ciphersuite_default_det = ciphersuite_strong_det
+
+----------------------------------------------------------------
+
+-- | The default ciphersuites + some not recommended last resort ciphers.
+--
+-- AEAD ciphers with equivalent security properties are ordered based on CPU
+-- hardware-acceleration support.  If this dynamic runtime behavior is not
+-- desired, use 'ciphersuite_all_det' instead.
+ciphersuite_all :: [Cipher]
+ciphersuite_all = ciphersuite_default ++ complement_all
+
+-- | Same as 'ciphersuite_all', but using deterministic preference not
+-- influenced by the CPU.
+ciphersuite_all_det :: [Cipher]
+ciphersuite_all_det = ciphersuite_default_det ++ complement_all
+
+complement_all :: [Cipher]
+complement_all =
+    [ cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8
+    , cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8
+    , cipher13_AES_128_CCM_8_SHA256
+    ]
+
+-- | The strongest ciphers supported.  For ciphers with PFS, AEAD and SHA2, we
+-- list each AES128 variant after the corresponding AES256 and ChaCha20-Poly1305
+-- variants.  For weaker constructs, we use just the AES256 form.
+--
+-- AEAD ciphers with equivalent security properties are ordered based on CPU
+-- hardware-acceleration support.  If this dynamic runtime behavior is not
+-- desired, use 'ciphersuite_strong_det' instead.
+ciphersuite_strong :: [Cipher]
+ciphersuite_strong = sortOptimized sets_strong
+
+-- | Same as 'ciphersuite_strong', but using deterministic preference not
+-- influenced by the CPU.
+ciphersuite_strong_det :: [Cipher]
+ciphersuite_strong_det = sortDeterministic sets_strong
+
+sets_strong :: [CipherSet]
+sets_strong =
+    [ -- If we have PFS + AEAD + SHA2, then allow AES128, else just 256
+      SetAead
+        [cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384]
+        [cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256]
+        [cipher_ECDHE_ECDSA_WITH_AES_256_CCM]
+    , SetAead
+        [cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256]
+        []
+        [cipher_ECDHE_ECDSA_WITH_AES_128_CCM]
+    , SetAead
+        [cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384]
+        [cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256]
+        []
+    , SetAead
+        [cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256]
+        []
+        []
+    , -- TLS13 (listed at the end but version is negotiated first)
+      SetAead
+        [cipher13_AES_256_GCM_SHA384]
+        [cipher13_CHACHA20_POLY1305_SHA256]
+        []
+    , SetAead
+        [cipher13_AES_128_GCM_SHA256]
+        []
+        [cipher13_AES_128_CCM_SHA256]
+    ]
+
+-- | DHE-RSA cipher suite.  This only includes ciphers bound specifically to
+-- DHE-RSA so TLS 1.3 ciphers must be added separately.
+--
+-- @since 2.1.5
+ciphersuite_dhe_rsa :: [Cipher]
+ciphersuite_dhe_rsa =
+    [ cipher_DHE_RSA_WITH_AES_256_GCM_SHA384
+    , cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+    , cipher_DHE_RSA_WITH_AES_128_GCM_SHA256
+    ]
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+-- A list of cipher suite is found from:
+-- https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-parameters-4
+
+----------------------------------------------------------------
+-- RFC 5288
+
+-- TLS_DHE_RSA_WITH_AES_128_GCM_SHA256
+cipher_DHE_RSA_WITH_AES_128_GCM_SHA256 :: Cipher
+cipher_DHE_RSA_WITH_AES_128_GCM_SHA256 =
+    Cipher
+        { cipherID = 0x009E
+        , cipherName = "TLS_DHE_RSA_WITH_AES_128_GCM_SHA256"
+        , cipherBulk = bulk_aes128gcm
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_DHE_RSA
+        , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4
+        }
+
+{-# DEPRECATED
+    cipher_DHE_RSA_AES128GCM_SHA256
+    "Use cipher_DHE_RSA_WITH_AES_128_GCM_SHA256 instead"
+    #-}
+cipher_DHE_RSA_AES128GCM_SHA256 :: Cipher
+cipher_DHE_RSA_AES128GCM_SHA256 = cipher_DHE_RSA_WITH_AES_128_GCM_SHA256
+
+-- TLS_DHE_RSA_WITH_AES_256_GCM_SHA384
+cipher_DHE_RSA_WITH_AES_256_GCM_SHA384 :: Cipher
+cipher_DHE_RSA_WITH_AES_256_GCM_SHA384 =
+    Cipher
+        { cipherID = 0x009F
+        , cipherName = "TLS_DHE_RSA_WITH_AES_256_GCM_SHA384"
+        , cipherBulk = bulk_aes256gcm
+        , cipherHash = SHA384
+        , cipherPRFHash = Just SHA384
+        , cipherKeyExchange = CipherKeyExchange_DHE_RSA
+        , cipherMinVer = Just TLS12
+        }
+
+{-# DEPRECATED
+    cipher_DHE_RSA_AES256GCM_SHA384
+    "Use cipher_DHE_RSA_WITH_AES_256_GCM_SHA384 instead"
+    #-}
+cipher_DHE_RSA_AES256GCM_SHA384 :: Cipher
+cipher_DHE_RSA_AES256GCM_SHA384 = cipher_DHE_RSA_WITH_AES_256_GCM_SHA384
+
+----------------------------------------------------------------
+-- RFC 8446
+
+-- TLS_AES_128_GCM_SHA256
+cipher13_AES_128_GCM_SHA256 :: Cipher
+cipher13_AES_128_GCM_SHA256 =
+    Cipher
+        { cipherID = 0x1301
+        , cipherName = "TLS_AES_128_GCM_SHA256"
+        , cipherBulk = bulk_aes128gcm_13
+        , cipherHash = SHA256
+        , cipherPRFHash = Nothing
+        , cipherKeyExchange = CipherKeyExchange_TLS13
+        , cipherMinVer = Just TLS13
+        }
+
+cipher_TLS13_AES128GCM_SHA256 :: Cipher
+cipher_TLS13_AES128GCM_SHA256 = cipher13_AES_128_GCM_SHA256
+{-# DEPRECATED
+    cipher_TLS13_AES128GCM_SHA256
+    "Use cipher13_AES_128_GCM_SHA256 instead"
+    #-}
+
+-- TLS_AES_256_GCM_SHA384
+cipher13_AES_256_GCM_SHA384 :: Cipher
+cipher13_AES_256_GCM_SHA384 =
+    Cipher
+        { cipherID = 0x1302
+        , cipherName = "TLS_AES_256_GCM_SHA384"
+        , cipherBulk = bulk_aes256gcm_13
+        , cipherHash = SHA384
+        , cipherPRFHash = Nothing
+        , cipherKeyExchange = CipherKeyExchange_TLS13
+        , cipherMinVer = Just TLS13
+        }
+
+cipher_TLS13_AES256GCM_SHA384 :: Cipher
+cipher_TLS13_AES256GCM_SHA384 = cipher13_AES_256_GCM_SHA384
+{-# DEPRECATED
+    cipher_TLS13_AES256GCM_SHA384
+    "Use cipher13_AES_256_GCM_SHA384 instead"
+    #-}
+
+-- TLS_CHACHA20_POLY1305_SHA256
+cipher13_CHACHA20_POLY1305_SHA256 :: Cipher
+cipher13_CHACHA20_POLY1305_SHA256 =
+    Cipher
+        { cipherID = 0x1303
+        , cipherName = "TLS_CHACHA20_POLY1305_SHA256"
+        , cipherBulk = bulk_chacha20poly1305
+        , cipherHash = SHA256
+        , cipherPRFHash = Nothing
+        , cipherKeyExchange = CipherKeyExchange_TLS13
+        , cipherMinVer = Just TLS13
+        }
+
+cipher_TLS13_CHACHA20POLY1305_SHA256 :: Cipher
+cipher_TLS13_CHACHA20POLY1305_SHA256 = cipher13_CHACHA20_POLY1305_SHA256
+{-# DEPRECATED
+    cipher_TLS13_CHACHA20POLY1305_SHA256
+    "Use cipher13_CHACHA20_POLY1305_SHA256 instead"
+    #-}
+
+-- TLS_AES_128_CCM_SHA256
+cipher13_AES_128_CCM_SHA256 :: Cipher
+cipher13_AES_128_CCM_SHA256 =
+    Cipher
+        { cipherID = 0x1304
+        , cipherName = "TLS_AES_128_CCM_SHA256"
+        , cipherBulk = bulk_aes128ccm_13
+        , cipherHash = SHA256
+        , cipherPRFHash = Nothing
+        , cipherKeyExchange = CipherKeyExchange_TLS13
+        , cipherMinVer = Just TLS13
+        }
+
+cipher_TLS13_AES128CCM_SHA256 :: Cipher
+cipher_TLS13_AES128CCM_SHA256 = cipher13_AES_128_CCM_SHA256
+{-# DEPRECATED
+    cipher_TLS13_AES128CCM_SHA256
+    "Use cipher13_AES_128_CCM_SHA256 instead"
+    #-}
+
+-- TLS_AES_128_CCM_8_SHA256
+cipher13_AES_128_CCM_8_SHA256 :: Cipher
+cipher13_AES_128_CCM_8_SHA256 =
+    Cipher
+        { cipherID = 0x1305
+        , cipherName = "TLS_AES_128_CCM_8_SHA256"
+        , cipherBulk = bulk_aes128ccm8_13
+        , cipherHash = SHA256
+        , cipherPRFHash = Nothing
+        , cipherKeyExchange = CipherKeyExchange_TLS13
+        , cipherMinVer = Just TLS13
+        }
+
+cipher_TLS13_AES128CCM8_SHA256 :: Cipher
+cipher_TLS13_AES128CCM8_SHA256 = cipher13_AES_128_CCM_8_SHA256
+{-# DEPRECATED
+    cipher_TLS13_AES128CCM8_SHA256
+    "Use cipher13_AES_128_CCM_8_SHA256 instead"
+    #-}
+
+----------------------------------------------------------------
+-- GCM: RFC 5289
+
+-- TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256
+cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 =
+    Cipher
+        { cipherID = 0xC02B
+        , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256"
+        , cipherBulk = bulk_aes128gcm
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 5289
+        }
+
+cipher_ECDHE_ECDSA_AES128GCM_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_AES128GCM_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256
+{-# DEPRECATED
+    cipher_ECDHE_ECDSA_AES128GCM_SHA256
+    "Use cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 instead"
+    #-}
+
+-- TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384
+cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 :: Cipher
+cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 =
+    Cipher
+        { cipherID = 0xC02C
+        , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384"
+        , cipherBulk = bulk_aes256gcm
+        , cipherHash = SHA384
+        , cipherPRFHash = Just SHA384
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 5289
+        }
+
+cipher_ECDHE_ECDSA_AES256GCM_SHA384 :: Cipher
+cipher_ECDHE_ECDSA_AES256GCM_SHA384 = cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384
+{-# DEPRECATED
+    cipher_ECDHE_ECDSA_AES256GCM_SHA384
+    "Use cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 instead"
+    #-}
+
+-- TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256
+cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256 :: Cipher
+cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256 =
+    Cipher
+        { cipherID = 0xC02F
+        , cipherName = "TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256"
+        , cipherBulk = bulk_aes128gcm
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA
+        , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4
+        }
+
+cipher_ECDHE_RSA_AES128GCM_SHA256 :: Cipher
+cipher_ECDHE_RSA_AES128GCM_SHA256 = cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256
+{-# DEPRECATED
+    cipher_ECDHE_RSA_AES128GCM_SHA256
+    "Use cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256 instead"
+    #-}
+
+-- TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384
+cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384 :: Cipher
+cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384 =
+    Cipher
+        { cipherID = 0xC030
+        , cipherName = "TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384"
+        , cipherBulk = bulk_aes256gcm
+        , cipherHash = SHA384
+        , cipherPRFHash = Just SHA384
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA
+        , cipherMinVer = Just TLS12 -- RFC 5289
+        }
+
+cipher_ECDHE_RSA_AES256GCM_SHA384 :: Cipher
+cipher_ECDHE_RSA_AES256GCM_SHA384 = cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384
+{-# DEPRECATED
+    cipher_ECDHE_RSA_AES256GCM_SHA384
+    "Use cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384 instead"
+    #-}
+
+----------------------------------------------------------------
+-- CCM/ECC: RFC 7251
+
+-- TLS_ECDHE_ECDSA_WITH_AES_128_CCM
+cipher_ECDHE_ECDSA_WITH_AES_128_CCM :: Cipher
+cipher_ECDHE_ECDSA_WITH_AES_128_CCM =
+    Cipher
+        { cipherID = 0xC0AC
+        , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_128_CCM"
+        , cipherBulk = bulk_aes128ccm
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 7251
+        }
+
+cipher_ECDHE_ECDSA_AES128CCM_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_AES128CCM_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_128_CCM
+{-# DEPRECATED
+    cipher_ECDHE_ECDSA_AES128CCM_SHA256
+    "User cipher_ECDHE_ECDSA_WITH_AES_128_CCM instead"
+    #-}
+
+-- TLS_ECDHE_ECDSA_WITH_AES_256_CCM
+cipher_ECDHE_ECDSA_WITH_AES_256_CCM :: Cipher
+cipher_ECDHE_ECDSA_WITH_AES_256_CCM =
+    Cipher
+        { cipherID = 0xC0AD
+        , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_256_CCM"
+        , cipherBulk = bulk_aes256ccm
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 7251
+        }
+
+cipher_ECDHE_ECDSA_AES256CCM_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_AES256CCM_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_256_CCM
+{-# DEPRECATED
+    cipher_ECDHE_ECDSA_AES256CCM_SHA256
+    "Use cipher_ECDHE_ECDSA_WITH_AES_256_CCM instead"
+    #-}
+
+-- TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8
+cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8 :: Cipher
+cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8 =
+    Cipher
+        { cipherID = 0xC0AE
+        , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8"
+        , cipherBulk = bulk_aes128ccm8
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 7251
+        }
+
+cipher_ECDHE_ECDSA_AES128CCM8_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_AES128CCM8_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8
+{-# DEPRECATED
+    cipher_ECDHE_ECDSA_AES128CCM8_SHA256
+    "Use cipher_ECDHE_ECDSA_WITH_AES_128_CCM_8 instead"
+    #-}
+
+-- TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8
+cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8 :: Cipher
+cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8 =
+    Cipher
+        { cipherID = 0xC0AF
+        , cipherName = "TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8"
+        , cipherBulk = bulk_aes256ccm8
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 7251
+        }
+
+cipher_ECDHE_ECDSA_AES256CCM8_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_AES256CCM8_SHA256 = cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8
+{-# DEPRECATED
+    cipher_ECDHE_ECDSA_AES256CCM8_SHA256
+    "Use cipher_ECDHE_ECDSA_WITH_AES_256_CCM_8 instead"
+    #-}
+
+----------------------------------------------------------------
+-- RFC 7905
+
+-- TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 :: Cipher
+cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 =
+    Cipher
+        { cipherID = 0xCCA8
+        , cipherName = "TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256"
+        , cipherBulk = bulk_chacha20poly1305
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA
+        , cipherMinVer = Just TLS12
+        }
+
+cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 :: Cipher
+cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 = cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+{-# DEPRECATED
+    cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256
+    "Use cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 instead"
+    #-}
+
+-- TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256
+cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 =
+    Cipher
+        { cipherID = 0xCCA9
+        , cipherName = "TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256"
+        , cipherBulk = bulk_chacha20poly1305
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12
+        }
+
+cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 = cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256
+{-# DEPRECATED
+    cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256
+    "Use cipher_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 instead"
+    #-}
+
+-- TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 :: Cipher
+cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 =
+    Cipher
+        { cipherID = 0xCCAA
+        , cipherName = "TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256"
+        , cipherBulk = bulk_chacha20poly1305
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_DHE_RSA
+        , cipherMinVer = Just TLS12
+        }
+
+cipher_DHE_RSA_CHACHA20POLY1305_SHA256 :: Cipher
+cipher_DHE_RSA_CHACHA20POLY1305_SHA256 = cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256
+{-# DEPRECATED
+    cipher_DHE_RSA_CHACHA20POLY1305_SHA256
+    "Use cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 instead"
+    #-}
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+data CipherSet
+    = SetAead [Cipher] [Cipher] [Cipher] -- gcm, chacha, ccm
+    | SetOther [Cipher]
+
+-- Preference between AEAD ciphers having equivalent properties is based on
+-- hardware-acceleration support in the crypton implementation.
+sortOptimized :: [CipherSet] -> [Cipher]
+sortOptimized = concatMap f
+  where
+    f (SetAead gcm chacha ccm)
+        | AESNI `notElem` processorOptions = chacha ++ gcm ++ ccm
+        | PCLMUL `notElem` processorOptions = ccm ++ chacha ++ gcm
+        | otherwise = gcm ++ ccm ++ chacha
+    f (SetOther ciphers) = ciphers
+
+-- Order which is deterministic but not optimized for the CPU.
+sortDeterministic :: [CipherSet] -> [Cipher]
+sortDeterministic = concatMap f
+  where
+    f (SetAead gcm chacha ccm) = gcm ++ chacha ++ ccm
+    f (SetOther ciphers) = ciphers
+
+----------------------------------------------------------------
+
+aes128ccm :: BulkDirection -> BulkKey -> BulkAEAD
+aes128ccm BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in swap $ aeadSimpleEncrypt aeadIni ad d 16
+        )
+aes128ccm BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in simpleDecrypt aeadIni ad d 16
+        )
+
+aes128ccm8 :: BulkDirection -> BulkKey -> BulkAEAD
+aes128ccm8 BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in swap $ aeadSimpleEncrypt aeadIni ad d 8
+        )
+aes128ccm8 BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in simpleDecrypt aeadIni ad d 8
+        )
+
+aes128gcm :: BulkDirection -> BulkKey -> BulkAEAD
+aes128gcm BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \nonce d ad ->
+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)
+             in swap $ aeadSimpleEncrypt aeadIni ad d 16
+        )
+aes128gcm BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \nonce d ad ->
+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)
+             in simpleDecrypt aeadIni ad d 16
+        )
+
+aes256ccm :: BulkDirection -> BulkKey -> BulkAEAD
+aes256ccm BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in swap $ aeadSimpleEncrypt aeadIni ad d 16
+        )
+aes256ccm BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M16 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in simpleDecrypt aeadIni ad d 16
+        )
+
+aes256ccm8 :: BulkDirection -> BulkKey -> BulkAEAD
+aes256ccm8 BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in swap $ aeadSimpleEncrypt aeadIni ad d 8
+        )
+aes256ccm8 BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \nonce d ad ->
+            let mode = AEAD_CCM (B.length d) CCM_M8 CCM_L3
+                aeadIni = noFail (aeadInit mode ctx nonce)
+             in simpleDecrypt aeadIni ad d 8
+        )
+
+aes256gcm :: BulkDirection -> BulkKey -> BulkAEAD
+aes256gcm BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \nonce d ad ->
+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)
+             in swap $ aeadSimpleEncrypt aeadIni ad d 16
+        )
+aes256gcm BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \nonce d ad ->
+            let aeadIni = noFail (aeadInit AEAD_GCM ctx nonce)
+             in simpleDecrypt aeadIni ad d 16
+        )
+
+simpleDecrypt
+    :: AEAD cipher -> ByteString -> ByteString -> Int -> (ByteString, AuthTag)
+simpleDecrypt aeadIni header input taglen = (output, tag)
+  where
+    aead = aeadAppendHeader aeadIni header
+    (output, aeadFinal) = aeadDecrypt aead input
+    tag = aeadFinalize aeadFinal taglen
+
+noFail :: CryptoFailable a -> a
+noFail = throwCryptoError
+
+chacha20poly1305 :: BulkDirection -> BulkKey -> BulkAEAD
+chacha20poly1305 BulkEncrypt key nonce =
+    let st = noFail (ChaChaPoly1305.nonce12 nonce >>= ChaChaPoly1305.initialize key)
+     in ( \input ad ->
+            let st2 = ChaChaPoly1305.finalizeAAD (ChaChaPoly1305.appendAAD ad st)
+                (output, st3) = ChaChaPoly1305.encrypt input st2
+                Poly1305.Auth tag = ChaChaPoly1305.finalize st3
+             in (output, AuthTag tag)
+        )
+chacha20poly1305 BulkDecrypt key nonce =
+    let st = noFail (ChaChaPoly1305.nonce12 nonce >>= ChaChaPoly1305.initialize key)
+     in ( \input ad ->
+            let st2 = ChaChaPoly1305.finalizeAAD (ChaChaPoly1305.appendAAD ad st)
+                (output, st3) = ChaChaPoly1305.decrypt input st2
+                Poly1305.Auth tag = ChaChaPoly1305.finalize st3
+             in (output, AuthTag tag)
+        )
+
+----------------------------------------------------------------
+
+bulk_aes128ccm :: Bulk
+bulk_aes128ccm =
+    Bulk
+        { bulkName = "AES128CCM"
+        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN
+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length
+        , bulkExplicitIV = 8
+        , bulkAuthTagLen = 16
+        , bulkBlockSize = 0 -- dummy, not used
+        , bulkF = BulkAeadF aes128ccm
+        }
+
+bulk_aes128ccm8 :: Bulk
+bulk_aes128ccm8 =
+    Bulk
+        { bulkName = "AES128CCM8"
+        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN
+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length
+        , bulkExplicitIV = 8
+        , bulkAuthTagLen = 8
+        , bulkBlockSize = 0 -- dummy, not used
+        , bulkF = BulkAeadF aes128ccm8
+        }
+
+bulk_aes128gcm :: Bulk
+bulk_aes128gcm =
+    Bulk
+        { bulkName = "AES128GCM"
+        , bulkKeySize = 16 -- RFC 5116 Sec 5.1: K_LEN
+        , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length
+        , bulkExplicitIV = 8
+        , bulkAuthTagLen = 16
+        , bulkBlockSize = 0 -- dummy, not used
+        , bulkF = BulkAeadF aes128gcm
+        }
+
+bulk_aes256ccm :: Bulk
+bulk_aes256ccm =
+    Bulk
+        { bulkName = "AES256CCM"
+        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN
+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length
+        , bulkExplicitIV = 8
+        , bulkAuthTagLen = 16
+        , bulkBlockSize = 0 -- dummy, not used
+        , bulkF = BulkAeadF aes256ccm
+        }
+
+bulk_aes256ccm8 :: Bulk
+bulk_aes256ccm8 =
+    Bulk
+        { bulkName = "AES256CCM8"
+        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN
+        , bulkIVSize = 4 -- RFC 6655 CCMNonce.salt, fixed_iv_length
+        , bulkExplicitIV = 8
+        , bulkAuthTagLen = 8
+        , bulkBlockSize = 0 -- dummy, not used
+        , bulkF = BulkAeadF aes256ccm8
+        }
+
+bulk_aes256gcm :: Bulk
+bulk_aes256gcm =
+    Bulk
+        { bulkName = "AES256GCM"
+        , bulkKeySize = 32 -- RFC 5116 Sec 5.1: K_LEN
+        , bulkIVSize = 4 -- RFC 5288 GCMNonce.salt, fixed_iv_length
+        , bulkExplicitIV = 8
+        , bulkAuthTagLen = 16
+        , bulkBlockSize = 0 -- dummy, not used
+        , bulkF = BulkAeadF aes256gcm
+        }
+
+bulk_chacha20poly1305 :: Bulk
+bulk_chacha20poly1305 =
+    Bulk
+        { bulkName = "CHACHA20POLY1305"
+        , bulkKeySize = 32
+        , bulkIVSize = 12 -- RFC 7905 section 2, fixed_iv_length
+        , bulkExplicitIV = 0
+        , bulkAuthTagLen = 16
+        , bulkBlockSize = 0 -- dummy, not used
+        , bulkF = BulkAeadF chacha20poly1305
+        }
+
+-- TLS13 bulks are same as TLS12 except they never have explicit IV
+bulk_aes128gcm_13 :: Bulk
+bulk_aes128gcm_13 = bulk_aes128gcm{bulkIVSize = 12, bulkExplicitIV = 0}
+
+bulk_aes256gcm_13 :: Bulk
+bulk_aes256gcm_13 = bulk_aes256gcm{bulkIVSize = 12, bulkExplicitIV = 0}
+
+bulk_aes128ccm_13 :: Bulk
+bulk_aes128ccm_13 = bulk_aes128ccm{bulkIVSize = 12, bulkExplicitIV = 0}
+
+bulk_aes128ccm8_13 :: Bulk
+bulk_aes128ccm8_13 = bulk_aes128ccm8{bulkIVSize = 12, bulkExplicitIV = 0}
diff --git a/Network/TLS/Extra/CipherCBC.hs b/Network/TLS/Extra/CipherCBC.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Extra/CipherCBC.hs
@@ -0,0 +1,201 @@
+module Network.TLS.Extra.CipherCBC (
+    -- * TLS 1.2 CBC ciphers with PFS and SHA2
+    ciphersuite_pfs_sha2_cbc,
+    ciphersuite_ecdhe_sha2_cbc,
+    ciphersuite_dhe_rsa_sha2_cbc,
+
+    -- ** Individual CBC ciphers
+    cipher_DHE_RSA_AES128_SHA256,
+    cipher_DHE_RSA_AES256_SHA256,
+    cipher_ECDHE_RSA_AES128CBC_SHA256,
+    cipher_ECDHE_RSA_AES256CBC_SHA384,
+    cipher_ECDHE_ECDSA_AES128CBC_SHA256,
+) where
+
+import Crypto.Cipher.AES
+import Crypto.Cipher.Types hiding (Cipher, cipherName)
+import Crypto.Error
+-- import Crypto.System.CPU
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Imports
+import Network.TLS.Types hiding (IV)
+
+----------------------------------------------------------------
+
+-- | TLS 1.2 AES CBC ciphers with DHE or ECDHE key exchange, ECDSA or RSA
+-- authentication and a SHA256 or SHA2384 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+ciphersuite_pfs_sha2_cbc :: [Cipher]
+ciphersuite_pfs_sha2_cbc =
+    [ cipher_ECDHE_ECDSA_AES128CBC_SHA256
+    , cipher_ECDHE_ECDSA_AES256CBC_SHA384
+    , cipher_ECDHE_RSA_AES128CBC_SHA256
+    , cipher_ECDHE_RSA_AES256CBC_SHA384
+    , cipher_DHE_RSA_AES128_SHA256
+    , cipher_DHE_RSA_AES256_SHA256
+    ]
+
+-- | TLS 1.2 AES CBC ciphers with ECDHE key exchange, ECDSA or RSA
+-- authentication and a SHA256 or SHA2384 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+ciphersuite_ecdhe_sha2_cbc :: [Cipher]
+ciphersuite_ecdhe_sha2_cbc =
+    [ cipher_ECDHE_ECDSA_AES128CBC_SHA256
+    , cipher_ECDHE_ECDSA_AES256CBC_SHA384
+    , cipher_ECDHE_RSA_AES128CBC_SHA256
+    , cipher_ECDHE_RSA_AES256CBC_SHA384
+    ]
+
+-- | TLS 1.2 AES CBC ciphers with DHE key exchange, RSA authentication and a
+-- SHA256 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+ciphersuite_dhe_rsa_sha2_cbc :: [Cipher]
+ciphersuite_dhe_rsa_sha2_cbc =
+    [ cipher_DHE_RSA_AES256_SHA256
+    , cipher_DHE_RSA_AES128_SHA256
+    ]
+
+----------------------------------------------------------------
+
+-- | TLS 1.2 AES128 CBC, with DHE key exchange, RSA authentication and a SHA256 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+cipher_DHE_RSA_AES128_SHA256 :: Cipher
+cipher_DHE_RSA_AES128_SHA256 =
+    Cipher
+        { cipherID = 0x0067
+        , cipherName = "DHE-RSA-AES128-SHA256"
+        , cipherBulk = bulk_aes128
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_DHE_RSA
+        , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4
+        }
+
+-- | TLS 1.2 AES256 CBC, with DHE key exchange, RSA authentication and a SHA256 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+cipher_DHE_RSA_AES256_SHA256 :: Cipher
+cipher_DHE_RSA_AES256_SHA256 =
+    cipher_DHE_RSA_AES128_SHA256
+        { cipherID = 0x006B
+        , cipherName = "DHE-RSA-AES256-SHA256"
+        , cipherBulk = bulk_aes256
+        }
+
+-- | TLS 1.2 AES128 CBC, with ECDHE key exchange, RSA authentication and a SHA256 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+cipher_ECDHE_RSA_AES128CBC_SHA256 :: Cipher
+cipher_ECDHE_RSA_AES128CBC_SHA256 =
+    Cipher
+        { cipherID = 0xC027
+        , cipherName = "ECDHE-RSA-AES128CBC-SHA256"
+        , cipherBulk = bulk_aes128
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA
+        , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4
+        }
+
+-- | TLS 1.2 AES256 CBC, with ECDHE key exchange, RSA authentication and a SHA384 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+cipher_ECDHE_RSA_AES256CBC_SHA384 :: Cipher
+cipher_ECDHE_RSA_AES256CBC_SHA384 =
+    Cipher
+        { cipherID = 0xC028
+        , cipherName = "ECDHE-RSA-AES256CBC-SHA384"
+        , cipherBulk = bulk_aes256
+        , cipherHash = SHA384
+        , cipherPRFHash = Just SHA384
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_RSA
+        , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4
+        }
+
+-- | TLS 1.2 AES128 CBC, with ECDHE key exchange, ECDSA authentication and a SHA256 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+cipher_ECDHE_ECDSA_AES128CBC_SHA256 :: Cipher
+cipher_ECDHE_ECDSA_AES128CBC_SHA256 =
+    Cipher
+        { cipherID = 0xc023
+        , cipherName = "ECDHE-ECDSA-AES128CBC-SHA256"
+        , cipherBulk = bulk_aes128
+        , cipherHash = SHA256
+        , cipherPRFHash = Just SHA256
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 5289
+        }
+
+-- | TLS 1.2 AES256 CBC, with ECDHE key exchange, ECDSA authentication and a SHA384 MAC.
+-- For legacy applications only, deprecated in HTTPS.
+cipher_ECDHE_ECDSA_AES256CBC_SHA384 :: Cipher
+cipher_ECDHE_ECDSA_AES256CBC_SHA384 =
+    Cipher
+        { cipherID = 0xC024
+        , cipherName = "ECDHE-ECDSA-AES256CBC-SHA384"
+        , cipherBulk = bulk_aes256
+        , cipherHash = SHA384
+        , cipherPRFHash = Just SHA384
+        , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA
+        , cipherMinVer = Just TLS12 -- RFC 5289
+        }
+
+----------------------------------------------------------------
+
+aes128cbc :: BulkDirection -> BulkKey -> BulkBlock
+aes128cbc BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \iv input ->
+            let output = cbcEncrypt ctx (makeIV_ iv) input in (output, takelast 16 output)
+        )
+aes128cbc BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES128
+     in ( \iv input ->
+            let output = cbcDecrypt ctx (makeIV_ iv) input in (output, takelast 16 input)
+        )
+
+aes256cbc :: BulkDirection -> BulkKey -> BulkBlock
+aes256cbc BulkEncrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \iv input ->
+            let output = cbcEncrypt ctx (makeIV_ iv) input in (output, takelast 16 output)
+        )
+aes256cbc BulkDecrypt key =
+    let ctx = noFail (cipherInit key) :: AES256
+     in ( \iv input ->
+            let output = cbcDecrypt ctx (makeIV_ iv) input in (output, takelast 16 input)
+        )
+
+makeIV_ :: BlockCipher a => B.ByteString -> IV a
+makeIV_ = fromMaybe (error "makeIV_") . makeIV
+
+takelast :: Int -> B.ByteString -> B.ByteString
+takelast i b = B.drop (B.length b - i) b
+
+noFail :: CryptoFailable a -> a
+noFail = throwCryptoError
+
+----------------------------------------------------------------
+
+bulk_aes128 :: Bulk
+bulk_aes128 =
+    Bulk
+        { bulkName = "AES128"
+        , bulkKeySize = 16
+        , bulkIVSize = 16
+        , bulkExplicitIV = 0
+        , bulkAuthTagLen = 0
+        , bulkBlockSize = 16
+        , bulkF = BulkBlockF aes128cbc
+        }
+
+bulk_aes256 :: Bulk
+bulk_aes256 =
+    Bulk
+        { bulkName = "AES256"
+        , bulkKeySize = 32
+        , bulkIVSize = 16
+        , bulkExplicitIV = 0
+        , bulkAuthTagLen = 0
+        , bulkBlockSize = 16
+        , bulkF = BulkBlockF aes256cbc
+        }
diff --git a/Network/TLS/Extra/FFDHE.hs b/Network/TLS/Extra/FFDHE.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Extra/FFDHE.hs
@@ -0,0 +1,72 @@
+-- |
+-- Module      : Network.TLS.Extra
+-- License     : BSD-style
+-- Maintainer  : Kazu Yamamoto <kazu@iij.ad.jp>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Finite Field Diffie-Hellman Ephemeral Parameters defined in RFC 7919.
+module Network.TLS.Extra.FFDHE where
+
+import Crypto.PubKey.DH
+import Network.TLS.Crypto.DH (DHParams)
+
+-- | 2048 bits finite field Diffie-Hellman ephemeral parameters
+--   defined in RFC 7919.
+--   The estimated symmetric-equivalent strength is 103 bits.
+ffdhe2048 :: DHParams
+ffdhe2048 =
+    Params
+        { params_p =
+            0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B423861285C97FFFFFFFFFFFFFFFF
+        , params_g = 2
+        , params_bits = 2048
+        }
+
+-- | 3072 bits finite field Diffie-Hellman ephemeral parameters
+--   defined in RFC 7919.
+--   The estimated symmetric-equivalent strength is 125 bits.
+ffdhe3072 :: DHParams
+ffdhe3072 =
+    Params
+        { params_p =
+            0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B66C62E37FFFFFFFFFFFFFFFF
+        , params_g = 2
+        , params_bits = 3072
+        }
+
+-- | 4096 bits finite field Diffie-Hellman ephemeral parameters
+--   defined in RFC 7919.
+--   The estimated symmetric-equivalent strength is 150 bits.
+ffdhe4096 :: DHParams
+ffdhe4096 =
+    Params
+        { params_p =
+            0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B669E1EF16E6F52C3164DF4FB7930E9E4E58857B6AC7D5F42D69F6D187763CF1D5503400487F55BA57E31CC7A7135C886EFB4318AED6A1E012D9E6832A907600A918130C46DC778F971AD0038092999A333CB8B7A1A1DB93D7140003C2A4ECEA9F98D0ACC0A8291CDCEC97DCF8EC9B55A7F88A46B4DB5A851F44182E1C68A007E5E655F6AFFFFFFFFFFFFFFFF
+        , params_g = 2
+        , params_bits = 4096
+        }
+
+-- | 6144 bits finite field Diffie-Hellman ephemeral parameters
+--   defined in RFC 7919.
+--   The estimated symmetric-equivalent strength is 175 bits.
+ffdhe6144 :: DHParams
+ffdhe6144 =
+    Params
+        { params_p =
+            0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B669E1EF16E6F52C3164DF4FB7930E9E4E58857B6AC7D5F42D69F6D187763CF1D5503400487F55BA57E31CC7A7135C886EFB4318AED6A1E012D9E6832A907600A918130C46DC778F971AD0038092999A333CB8B7A1A1DB93D7140003C2A4ECEA9F98D0ACC0A8291CDCEC97DCF8EC9B55A7F88A46B4DB5A851F44182E1C68A007E5E0DD9020BFD64B645036C7A4E677D2C38532A3A23BA4442CAF53EA63BB454329B7624C8917BDD64B1C0FD4CB38E8C334C701C3ACDAD0657FCCFEC719B1F5C3E4E46041F388147FB4CFDB477A52471F7A9A96910B855322EDB6340D8A00EF092350511E30ABEC1FFF9E3A26E7FB29F8C183023C3587E38DA0077D9B4763E4E4B94B2BBC194C6651E77CAF992EEAAC0232A281BF6B3A739C1226116820AE8DB5847A67CBEF9C9091B462D538CD72B03746AE77F5E62292C311562A846505DC82DB854338AE49F5235C95B91178CCF2DD5CACEF403EC9D1810C6272B045B3B71F9DC6B80D63FDD4A8E9ADB1E6962A69526D43161C1A41D570D7938DAD4A40E329CD0E40E65FFFFFFFFFFFFFFFF
+        , params_g = 2
+        , params_bits = 6144
+        }
+
+-- | 8192 bits finite field Diffie-Hellman ephemeral parameters
+--   defined in RFC 7919.
+--   The estimated symmetric-equivalent strength is 192 bits.
+ffdhe8192 :: DHParams
+ffdhe8192 =
+    Params
+        { params_p =
+            0xFFFFFFFFFFFFFFFFADF85458A2BB4A9AAFDC5620273D3CF1D8B9C583CE2D3695A9E13641146433FBCC939DCE249B3EF97D2FE363630C75D8F681B202AEC4617AD3DF1ED5D5FD65612433F51F5F066ED0856365553DED1AF3B557135E7F57C935984F0C70E0E68B77E2A689DAF3EFE8721DF158A136ADE73530ACCA4F483A797ABC0AB182B324FB61D108A94BB2C8E3FBB96ADAB760D7F4681D4F42A3DE394DF4AE56EDE76372BB190B07A7C8EE0A6D709E02FCE1CDF7E2ECC03404CD28342F619172FE9CE98583FF8E4F1232EEF28183C3FE3B1B4C6FAD733BB5FCBC2EC22005C58EF1837D1683B2C6F34A26C1B2EFFA886B4238611FCFDCDE355B3B6519035BBC34F4DEF99C023861B46FC9D6E6C9077AD91D2691F7F7EE598CB0FAC186D91CAEFE130985139270B4130C93BC437944F4FD4452E2D74DD364F2E21E71F54BFF5CAE82AB9C9DF69EE86D2BC522363A0DABC521979B0DEADA1DBF9A42D5C4484E0ABCD06BFA53DDEF3C1B20EE3FD59D7C25E41D2B669E1EF16E6F52C3164DF4FB7930E9E4E58857B6AC7D5F42D69F6D187763CF1D5503400487F55BA57E31CC7A7135C886EFB4318AED6A1E012D9E6832A907600A918130C46DC778F971AD0038092999A333CB8B7A1A1DB93D7140003C2A4ECEA9F98D0ACC0A8291CDCEC97DCF8EC9B55A7F88A46B4DB5A851F44182E1C68A007E5E0DD9020BFD64B645036C7A4E677D2C38532A3A23BA4442CAF53EA63BB454329B7624C8917BDD64B1C0FD4CB38E8C334C701C3ACDAD0657FCCFEC719B1F5C3E4E46041F388147FB4CFDB477A52471F7A9A96910B855322EDB6340D8A00EF092350511E30ABEC1FFF9E3A26E7FB29F8C183023C3587E38DA0077D9B4763E4E4B94B2BBC194C6651E77CAF992EEAAC0232A281BF6B3A739C1226116820AE8DB5847A67CBEF9C9091B462D538CD72B03746AE77F5E62292C311562A846505DC82DB854338AE49F5235C95B91178CCF2DD5CACEF403EC9D1810C6272B045B3B71F9DC6B80D63FDD4A8E9ADB1E6962A69526D43161C1A41D570D7938DAD4A40E329CCFF46AAA36AD004CF600C8381E425A31D951AE64FDB23FCEC9509D43687FEB69EDD1CC5E0B8CC3BDF64B10EF86B63142A3AB8829555B2F747C932665CB2C0F1CC01BD70229388839D2AF05E454504AC78B7582822846C0BA35C35F5C59160CC046FD8251541FC68C9C86B022BB7099876A460E7451A8A93109703FEE1C217E6C3826E52C51AA691E0E423CFC99E9E31650C1217B624816CDAD9A95F9D5B8019488D9C0A0A1FE3075A577E23183F81D4A3F2FA4571EFC8CE0BA8A4FE8B6855DFE72B0A66EDED2FBABFBE58A30FAFABE1C5D71A87E2F741EF8C1FE86FEA6BBFDE530677F0D97D11D49F7A8443D0822E506A9F4614E011E2A94838FF88CD68C8BB7C5C6424CFFFFFFFFFFFFFFFF
+        , params_g = 2
+        , params_bits = 8192
+        }
diff --git a/Network/TLS/Handshake.hs b/Network/TLS/Handshake.hs
--- a/Network/TLS/Handshake.hs
+++ b/Network/TLS/Handshake.hs
@@ -1,37 +1,33 @@
--- |
--- Module      : Network.TLS.Handshake
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Handshake
-    ( handshake
-    , handshakeClientWith
-    , handshakeServerWith
-    , handshakeClient
-    , handshakeServer
-    ) where
+module Network.TLS.Handshake (
+    handshake_,
+    handshakeWith,
+    handshakeClientWith,
+    handshakeServerWith,
+    handshakeClient,
+    handshakeServer,
+) where
 
 import Network.TLS.Context.Internal
-import Network.TLS.Struct
-import Network.TLS.IO
-import Network.TLS.Util (catchException)
-
-import Network.TLS.Handshake.Common
 import Network.TLS.Handshake.Client
+import Network.TLS.Handshake.Common
 import Network.TLS.Handshake.Server
+import Network.TLS.Struct
 
-import Control.Monad.State
-import Control.Exception (fromException)
+import Control.Monad.State.Strict
 
--- | Handshake for a new TLS connection
--- This is to be called at the beginning of a connection, and during renegotiation
-handshake :: MonadIO m => Context -> m ()
-handshake ctx =
-    liftIO $ handleException $ withRWLock ctx (ctxDoHandshake ctx $ ctx)
-  where handleException f = catchException f $ \exception -> do
-            let tlserror = maybe (Error_Misc $ show exception) id $ fromException exception
-            setEstablished ctx False
-            sendPacket ctx (errorToAlert tlserror)
-            handshakeFailed tlserror
+handshake_ :: MonadIO m => Context -> m ()
+handshake_ ctx =
+    liftIO $
+        withRWLock ctx $
+            handleException ctx (doHandshake_ (ctxRoleParams ctx) ctx)
+
+-- Handshake when requested by the remote end
+-- This is called automatically by 'recvData', in a context where the read lock
+-- is already taken.  So contrary to 'handshake' above, here we only need to
+-- call withWriteLock.
+handshakeWith :: MonadIO m => Context -> HandshakeR -> m ()
+handshakeWith ctx hsr =
+    liftIO $
+        withWriteLock ctx $
+            handleException ctx $
+                doHandshakeWith_ (ctxRoleParams ctx) ctx hsr
diff --git a/Network/TLS/Handshake/Certificate.hs b/Network/TLS/Handshake/Certificate.hs
--- a/Network/TLS/Handshake/Certificate.hs
+++ b/Network/TLS/Handshake/Certificate.hs
@@ -1,31 +1,71 @@
--- |
--- Module      : Network.TLS.Handshake.Certificate
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Handshake.Certificate
-    ( certificateRejected
-    , rejectOnException
-    ) where
+module Network.TLS.Handshake.Certificate (
+    certificateRejected,
+    badCertificate,
+    rejectOnException,
+    verifyLeafKeyUsage,
+    verifyLeafKeyUsagePurpose,
+    extractCAname,
+) where
 
+import Control.Exception (SomeException)
+import Control.Monad (unless)
+import Control.Monad.State.Strict
+import Data.X509 (
+    ExtExtendedKeyUsage (..),
+    ExtKeyUsage (..),
+    ExtKeyUsageFlag,
+    ExtKeyUsagePurpose (..),
+    extensionGet,
+ )
+
 import Network.TLS.Context.Internal
 import Network.TLS.Struct
 import Network.TLS.X509
-import Control.Monad.State
-import Control.Exception (SomeException)
 
 -- on certificate reject, throw an exception with the proper protocol alert error.
 certificateRejected :: MonadIO m => CertificateRejectReason -> m a
 certificateRejected CertificateRejectRevoked =
-    throwCore $ Error_Protocol ("certificate is revoked", True, CertificateRevoked)
+    throwCore $ Error_Protocol "certificate is revoked" CertificateRevoked
 certificateRejected CertificateRejectExpired =
-    throwCore $ Error_Protocol ("certificate has expired", True, CertificateExpired)
+    throwCore $ Error_Protocol "certificate has expired" CertificateExpired
 certificateRejected CertificateRejectUnknownCA =
-    throwCore $ Error_Protocol ("certificate has unknown CA", True, UnknownCa)
+    throwCore $ Error_Protocol "certificate has unknown CA" UnknownCa
+certificateRejected CertificateRejectAbsent =
+    throwCore $ Error_Protocol "certificate is missing" CertificateRequired
 certificateRejected (CertificateRejectOther s) =
-    throwCore $ Error_Protocol ("certificate rejected: " ++ s, True, CertificateUnknown)
+    throwCore $ Error_Protocol ("certificate rejected: " ++ s) CertificateUnknown
 
+badCertificate :: MonadIO m => String -> m a
+badCertificate msg = throwCore $ Error_Protocol msg BadCertificate
+
 rejectOnException :: SomeException -> IO CertificateUsage
 rejectOnException e = return $ CertificateUsageReject $ CertificateRejectOther $ show e
+
+verifyLeafKeyUsage :: MonadIO m => [ExtKeyUsageFlag] -> CertificateChain -> m ()
+verifyLeafKeyUsage _ (CertificateChain []) = return ()
+verifyLeafKeyUsage validFlags (CertificateChain (signed : _)) =
+    unless verified $
+        badCertificate $
+            "certificate is not allowed for any of " ++ show validFlags
+  where
+    cert = getCertificate signed
+    verified =
+        case extensionGet (certExtensions cert) of
+            Nothing -> True -- unrestricted cert
+            Just (ExtKeyUsage flags) -> any (`elem` validFlags) flags
+
+verifyLeafKeyUsagePurpose
+    :: MonadIO m => ExtKeyUsagePurpose -> CertificateChain -> m ()
+verifyLeafKeyUsagePurpose _ (CertificateChain []) = return ()
+verifyLeafKeyUsagePurpose validPurpose (CertificateChain (signed : _)) =
+    unless verified $
+        badCertificate $
+            "certificate is not allowed for " ++ show validPurpose
+  where
+    cert = getCertificate signed
+    verified = case extensionGet (certExtensions cert) of
+        Nothing -> True
+        Just (ExtExtendedKeyUsage purposes) -> validPurpose `elem` purposes
+
+extractCAname :: SignedCertificate -> DistinguishedName
+extractCAname cert = certSubjectDN $ getCertificate cert
diff --git a/Network/TLS/Handshake/Client.hs b/Network/TLS/Handshake/Client.hs
--- a/Network/TLS/Handshake/Client.hs
+++ b/Network/TLS/Handshake/Client.hs
@@ -1,355 +1,177 @@
-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
--- |
--- Module      : Network.TLS.Handshake.Client
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Handshake.Client
-    ( handshakeClient
-    , handshakeClientWith
-    ) where
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
-import Network.TLS.Crypto
+module Network.TLS.Handshake.Client (
+    handshakeClient,
+    handshakeClientWith,
+    postHandshakeAuthClientWith,
+) where
+
 import Network.TLS.Context.Internal
-import Network.TLS.Parameters
-import Network.TLS.Struct
-import Network.TLS.Cipher
-import Network.TLS.Compression
-import Network.TLS.Packet
+import Network.TLS.Crypto
 import Network.TLS.Extension
+import Network.TLS.Handshake.Client.ClientHello
+import Network.TLS.Handshake.Client.Common
+import Network.TLS.Handshake.Client.ServerHello
+import Network.TLS.Handshake.Client.TLS12
+import Network.TLS.Handshake.Client.TLS13
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
 import Network.TLS.IO
-import Network.TLS.State hiding (getNegotiatedProtocol)
+import Network.TLS.Imports
 import Network.TLS.Measurement
-import Network.TLS.Wire (encodeWord16)
-import Network.TLS.Util (bytesEq, catchException)
-import Network.TLS.Types
-import Network.TLS.X509
-import Data.Maybe
-import Data.List (find)
-import qualified Data.ByteString as B
-import Data.ByteString.Char8 ()
-
-import Control.Applicative ((<$>), (<*>))
-import Control.Monad.State
-import Control.Monad.Error
-import Control.Exception (SomeException)
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
 
-import Network.TLS.Handshake.Common
-import Network.TLS.Handshake.Process
-import Network.TLS.Handshake.Certificate
-import Network.TLS.Handshake.Signature
-import Network.TLS.Handshake.Key
-import Network.TLS.Handshake.State
+----------------------------------------------------------------
 
-handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()
-handshakeClientWith cparams ctx HelloRequest = handshakeClient cparams ctx
-handshakeClientWith _       _   _            = throwCore $ Error_Protocol ("unexpected handshake message received in handshakeClientWith", True, HandshakeFailure)
+handshakeClientWith
+    :: ClientParams -> Context -> HandshakeR -> IO ()
+handshakeClientWith cparams ctx (HelloRequest, _b) = handshakeClient cparams ctx -- xxx
+handshakeClientWith _ _ _ =
+    throwCore $
+        Error_Protocol
+            "unexpected handshake message received in handshakeClientWith"
+            HandshakeFailure
 
 -- client part of handshake. send a bunch of handshake of client
 -- values intertwined with response from the server.
 handshakeClient :: ClientParams -> Context -> IO ()
 handshakeClient cparams ctx = do
-    updateMeasure ctx incrementNbHandshakes
-    sentExtensions <- sendClientHello
-    recvServerHello sentExtensions
-    sessionResuming <- usingState_ ctx isSessionResuming
-    if sessionResuming
-        then sendChangeCipherAndFinish sendMaybeNPN ctx ClientRole
-        else do sendClientData cparams ctx
-                sendChangeCipherAndFinish sendMaybeNPN ctx ClientRole
-                recvChangeCipherAndFinish ctx
-    handshakeTerminate ctx
-  where ciphers      = ctxCiphers ctx
-        compressions = supportedCompressions $ ctxSupported ctx
-        getExtensions = sequence [sniExtension,secureReneg,npnExtention] >>= return . catMaybes
-
-        toExtensionRaw :: Extension e => e -> ExtensionRaw
-        toExtensionRaw ext = (extensionID ext, extensionEncode ext)
-
-        secureReneg  =
-                if supportedSecureRenegotiation $ ctxSupported ctx
-                then usingState_ ctx (getVerifiedData ClientRole) >>= \vd -> return $ Just $ toExtensionRaw $ SecureRenegotiation vd Nothing
-                else return Nothing
-        npnExtention = if isJust $ onNPNServerSuggest $ clientHooks cparams
-                         then return $ Just $ toExtensionRaw $ NextProtocolNegotiation []
-                         else return Nothing
-        sniExtension = if clientUseServerNameIndication cparams
-                         then return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName $ fst $ clientServerIdentification cparams]
-                         else return Nothing
-        sendClientHello = do
-            crand <- getStateRNG ctx 32 >>= return . ClientRandom
-            let clientSession = Session . maybe Nothing (Just . fst) $ clientWantSessionResume cparams
-                highestVer = maximum $ supportedVersions $ ctxSupported ctx
-            extensions <- getExtensions
-            startHandshake ctx highestVer crand
-            usingState_ ctx $ setVersionIfUnset highestVer
-            sendPacket ctx $ Handshake
-                [ ClientHello highestVer crand clientSession (map cipherID ciphers)
-                              (map compressionID compressions) extensions Nothing
-                ]
-            return $ map fst extensions
-
-        sendMaybeNPN = do
-            suggest <- usingState_ ctx $ getServerNextProtocolSuggest
-            case (onNPNServerSuggest $ clientHooks cparams, suggest) of
-                -- client offered, server picked up. send NPN handshake.
-                (Just io, Just protos) -> do proto <- liftIO $ io protos
-                                             sendPacket ctx (Handshake [HsNextProtocolNegotiation proto])
-                                             usingState_ ctx $ setNegotiatedProtocol proto
-                -- client offered, server didn't pick up. do nothing.
-                (Just _, Nothing) -> return ()
-                -- client didn't offer. do nothing.
-                (Nothing, _) -> return ()
-
-        recvServerHello sentExts = runRecvState ctx recvState
-          where recvState = RecvStateNext $ \p ->
-                    case p of
-                        Handshake hs -> onRecvStateHandshake ctx (RecvStateHandshake $ onServerHello ctx cparams sentExts) hs
-                        Alert a      ->
-                            case a of
-                                [(AlertLevel_Warning, UnrecognizedName)] ->
-                                    if clientUseServerNameIndication cparams
-                                        then return recvState
-                                        else throwAlert a
-                                _ -> throwAlert a
-                        _ -> fail ("unexepected type received. expecting handshake and got: " ++ show p)
-                throwAlert a = usingState_ ctx $ throwError $ Error_Protocol ("expecting server hello, got alert : " ++ show a, True, HandshakeFailure)
-
--- | send client Data after receiving all server data (hello/certificates/key).
---
---       -> [certificate]
---       -> client key exchange
---       -> [cert verify]
-sendClientData :: ClientParams -> Context -> IO ()
-sendClientData cparams ctx = sendCertificate >> sendClientKeyXchg >> sendCertificateVerify
+    grps <- case clientSessions cparams of
+        [] ->
+            return $
+                Groups
+                    { grpsSupported = groupsSupported
+                    , grpsSelected = groupsSelected
+                    }
+        (_, sdata) : _ -> case sessionGroup sdata of
+            Nothing ->
+                -- TLS 1.2 or earlier
+                return $
+                    Groups
+                        { grpsSupported = groupsSupported -- for ciphers
+                        , grpsSelected = []
+                        }
+            Just grp
+                | grp `elem` groupsSupported -> do
+                    let supported = grp : filter (/= grp) groupsSupported
+                    return $
+                        Groups
+                            { grpsSupported = supported
+                            , grpsSelected = [grp]
+                            }
+                | otherwise -> throwCore $ Error_Misc "groupsSupported is incorrect"
+    handshake cparams ctx grps Nothing
   where
-        -- When the server requests a client certificate, we
-        -- fetch a certificate chain from the callback in the
-        -- client parameters and send it to the server.
-        -- Additionally, we store the private key associated
-        -- with the first certificate in the chain for later
-        -- use.
-        --
-        sendCertificate = do
-            certRequested <- usingHState ctx getClientCertRequest
-            case certRequested of
-                Nothing ->
-                    return ()
-
-                Just req -> do
-                    certChain <- liftIO $ (onCertificateRequest $ clientHooks cparams) req `catchException`
-                                 throwMiscErrorOnException "certificate request callback failed"
-
-                    usingHState ctx $ setClientCertSent False
-                    case certChain of
-                        Nothing                       -> sendPacket ctx $ Handshake [Certificates (CertificateChain [])]
-                        Just (CertificateChain [], _) -> sendPacket ctx $ Handshake [Certificates (CertificateChain [])]
-                        Just (cc@(CertificateChain (c:_)), pk) -> do
-                            case certPubKey $ getCertificate c of
-                                PubKeyRSA _ -> return ()
-                                _           -> throwCore $ Error_Protocol ("no supported certificate type", True, HandshakeFailure)
-                            usingHState ctx $ setPrivateKey pk
-                            usingHState ctx $ setClientCertSent True
-                            sendPacket ctx $ Handshake [Certificates cc]
-
-        sendClientKeyXchg = do
-            cipher <- usingHState ctx getPendingCipher
-            ckx <- case cipherKeyExchange cipher of
-                CipherKeyExchange_RSA -> do
-                    clientVersion <- usingHState ctx $ gets hstClientVersion
-                    (xver, prerand) <- usingState_ ctx $ (,) <$> getVersion <*> genRandom 46
-
-                    let premaster = encodePreMasterSecret clientVersion prerand
-                    usingHState ctx $ setMasterSecretFromPre xver ClientRole premaster
-                    encryptedPreMaster <- do
-                        -- SSL3 implementation generally forget this length field since it's redundant,
-                        -- however TLS10 make it clear that the length field need to be present.
-                        e <- encryptRSA ctx premaster
-                        let extra = if xver < TLS10
-                                        then B.empty
-                                        else encodeWord16 $ fromIntegral $ B.length e
-                        return $ extra `B.append` e
-                    return $ CKX_RSA encryptedPreMaster
-                CipherKeyExchange_DHE_RSA -> getCKX_DHE
-                CipherKeyExchange_DHE_DSS -> getCKX_DHE
-                _ -> throwCore $ Error_Protocol ("client key exchange unsupported type", True, HandshakeFailure)
-            sendPacket ctx $ Handshake [ClientKeyXchg ckx]
-          where getCKX_DHE = do
-                    xver <- usingState_ ctx getVersion
-                    (ServerDHParams dhparams serverDHPub) <- fromJust <$> usingHState ctx (gets hstServerDHParams)
-                    (clientDHPriv, clientDHPub) <- generateDHE ctx dhparams
-
-                    let premaster = dhGetShared dhparams clientDHPriv serverDHPub
-                    usingHState ctx $ setMasterSecretFromPre xver ClientRole premaster
-
-                    return $ CKX_DH clientDHPub
-
-        -- In order to send a proper certificate verify message,
-        -- we have to do the following:
-        --
-        -- 1. Determine which signing algorithm(s) the server supports
-        --    (we currently only support RSA).
-        -- 2. Get the current handshake hash from the handshake state.
-        -- 3. Sign the handshake hash
-        -- 4. Send it to the server.
-        --
-        sendCertificateVerify = do
-            usedVersion <- usingState_ ctx getVersion
-
-            -- Only send a certificate verify message when we
-            -- have sent a non-empty list of certificates.
-            --
-            certSent <- usingHState ctx $ getClientCertSent
-            case certSent of
-                True -> do
-                    malg <- case usedVersion of
-                        TLS12 -> do
-                            Just (_, Just hashSigs, _) <- usingHState ctx $ getClientCertRequest
-                            let suppHashSigs = supportedHashSignatures $ ctxSupported ctx
-                                hashSigs' = filter (\ a -> a `elem` hashSigs) suppHashSigs
-
-                            when (null hashSigs') $
-                                throwCore $ Error_Protocol ("no hash/signature algorithms in common with the server", True, HandshakeFailure)
-                            return $ Just $ head hashSigs'
-                        _     -> return Nothing
-
-                    -- Fetch all handshake messages up to now.
-                    msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
-                    (hashMethod, toSign) <- prepareCertificateVerifySignatureData ctx usedVersion malg msgs
-
-                    sigDig <- signatureCreate ctx malg hashMethod toSign
-                    sendPacket ctx $ Handshake [CertVerify sigDig]
-
-                _ -> return ()
-
-processServerExtension :: (ExtensionID, Bytes) -> TLSSt ()
-processServerExtension (0xff01, content) = do
-    cv <- getVerifiedData ClientRole
-    sv <- getVerifiedData ServerRole
-    let bs = extensionEncode (SecureRenegotiation cv $ Just sv)
-    unless (bs `bytesEq` content) $ throwError $ Error_Protocol ("server secure renegotiation data not matching", True, HandshakeFailure)
-    return ()
-processServerExtension _ = return ()
-
-throwMiscErrorOnException :: String -> SomeException -> IO a
-throwMiscErrorOnException msg e =
-    throwCore $ Error_Misc $ msg ++ ": " ++ show e
+    groupsSupported = supportedGroups (ctxSupported ctx)
+    groupsSelected = onSelectKeyShareGroups (clientHooks cparams) groupsSupported
 
--- | onServerHello process the ServerHello message on the client.
---
--- 1) check the version chosen by the server is one allowed by parameters.
--- 2) check that our compression and cipher algorithms are part of the list we sent
--- 3) check extensions received are part of the one we sent
--- 4) process the session parameter to see if the server want to start a new session or can resume
--- 5) process NPN extension
--- 6) if no resume switch to processCertificate SM or in resume switch to expectChangeCipher
+-- https://tools.ietf.org/html/rfc8446#section-4.1.2 says:
+-- "The client will also send a
+--  ClientHello when the server has responded to its ClientHello with a
+--  HelloRetryRequest.  In that case, the client MUST send the same
+--  ClientHello without modification, except as follows:"
 --
-onServerHello :: Context -> ClientParams -> [ExtensionID] -> Handshake -> IO (RecvState IO)
-onServerHello ctx cparams sentExts (ServerHello rver serverRan serverSession cipher compression exts) = do
-    when (rver == SSL2) $ throwCore $ Error_Protocol ("ssl2 is not supported", True, ProtocolVersion)
-    case find ((==) rver) (supportedVersions $ ctxSupported ctx) of
-        Nothing -> throwCore $ Error_Protocol ("server version " ++ show rver ++ " is not supported", True, ProtocolVersion)
-        Just _  -> return ()
-    -- find the compression and cipher methods that the server want to use.
-    cipherAlg <- case find ((==) cipher . cipherID) (ctxCiphers ctx) of
-                     Nothing  -> throwCore $ Error_Protocol ("server choose unknown cipher", True, HandshakeFailure)
-                     Just alg -> return alg
-    compressAlg <- case find ((==) compression . compressionID) (supportedCompressions $ ctxSupported ctx) of
-                       Nothing  -> throwCore $ Error_Protocol ("server choose unknown compression", True, HandshakeFailure)
-                       Just alg -> return alg
-
-    -- intersect sent extensions in client and the received extensions from server.
-    -- if server returns extensions that we didn't request, fail.
-    when (not $ null $ filter (not . flip elem sentExts . fst) exts) $
-        throwCore $ Error_Protocol ("spurious extensions received", True, UnsupportedExtension)
-
-    let resumingSession =
-            case clientWantSessionResume cparams of
-                Just (sessionId, sessionData) -> if serverSession == Session (Just sessionId) then Just sessionData else Nothing
-                Nothing                       -> Nothing
-    usingState_ ctx $ do
-        setSession serverSession (isJust resumingSession)
-        mapM_ processServerExtension exts
-        setVersion rver
-    usingHState ctx $ setServerHelloParameters rver serverRan cipherAlg compressAlg
-
-    case extensionDecode False `fmap` (lookup extensionID_NextProtocolNegotiation exts) of
-        Just (Just (NextProtocolNegotiation protos)) -> usingState_ ctx $ do
-            setExtensionNPN True
-            setServerNextProtocolSuggest protos
-        _ -> return ()
-
-    case resumingSession of
-        Nothing          -> return $ RecvStateHandshake (processCertificate cparams ctx)
-        Just sessionData -> do
-            usingHState ctx (setMasterSecret rver ClientRole $ sessionSecret sessionData)
-            return $ RecvStateNext expectChangeCipher
-onServerHello _ _ _ p = unexpected (show p) (Just "server hello")
-
-processCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
-processCertificate cparams ctx (Certificates certs) = do
-    -- run certificate recv hook
-    ctxWithHooks ctx (\hooks -> hookRecvCertificates hooks $ certs)
-    -- then run certificate validation
-    usage <- catchException (wrapCertificateChecks <$> checkCert) rejectOnException
-    case usage of
-        CertificateUsageAccept        -> return ()
-        CertificateUsageReject reason -> certificateRejected reason
-    return $ RecvStateHandshake (processServerKeyExchange ctx)
-  where shared = clientShared cparams
-        checkCert = (onServerCertificate $ clientHooks cparams) (sharedCAStore shared)
-                                                                (sharedValidationCache shared)
-                                                                (clientServerIdentification cparams)
-                                                                certs
-processCertificate _ ctx p = processServerKeyExchange ctx p
-
-expectChangeCipher :: Packet -> IO (RecvState IO)
-expectChangeCipher ChangeCipherSpec = return $ RecvStateHandshake expectFinish
-expectChangeCipher p                = unexpected (show p) (Just "change cipher")
-
-expectFinish :: Handshake -> IO (RecvState IO)
-expectFinish (Finished _) = return RecvStateDone
-expectFinish p            = unexpected (show p) (Just "Handshake Finished")
-
-processServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
-processServerKeyExchange ctx (ServerKeyXchg origSkx) = do
-    cipher <- usingHState ctx getPendingCipher
-    processWithCipher cipher origSkx
-    return $ RecvStateHandshake (processCertificateRequest ctx)
-  where processWithCipher cipher skx =
-            case (cipherKeyExchange cipher, skx) of
-                (CipherKeyExchange_DHE_RSA, SKX_DHE_RSA dhparams signature) -> do
-                    doDHESignature dhparams signature SignatureRSA
-                (CipherKeyExchange_DHE_DSS, SKX_DHE_DSS dhparams signature) -> do
-                    doDHESignature dhparams signature SignatureDSS
-                (cke, SKX_Unparsed bytes) -> do
-                    ver <- usingState_ ctx getVersion
-                    case decodeReallyServerKeyXchgAlgorithmData ver cke bytes of
-                        Left _        -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show cke, True, HandshakeFailure)
-                        Right realSkx -> processWithCipher cipher realSkx
-                    -- we need to resolve the result. and recall processWithCipher ..
-                (c,_)           -> throwCore $ Error_Protocol ("unknown server key exchange received, expecting: " ++ show c, True, HandshakeFailure)
-        doDHESignature dhparams signature signatureType = do
-            -- TODO verify DHParams
-            expectedData <- generateSignedDHParams ctx dhparams
-            verified <- signatureVerify ctx signatureType expectedData signature
-            when (not verified) $ throwCore $ Error_Protocol ("bad " ++ show signatureType ++ " for dhparams", True, HandshakeFailure)
-            usingHState ctx $ setServerDHParams dhparams
+-- So, the ClientRandom in the first client hello is necessary.
+handshake
+    :: ClientParams
+    -> Context
+    -> Groups
+    -> Maybe (ClientRandom, Session, Version)
+    -> IO ()
+handshake cparams ctx grps@Groups{..} mparams = do
+    --------------------------------
+    -- Sending ClientHello
+    pskinfo@(_, _, rtt0) <- getPreSharedKeyInfo cparams ctx
+    when rtt0 $ modifyTLS13State ctx $ \st -> st{tls13st0RTT = True}
+    let async = rtt0 && not (ctxQUICMode ctx)
+    when async $ do
+        chSentTime <- getCurrentTimeFromBase
+        asyncServerHello13 cparams ctx grpsSelected chSentTime
+    updateMeasure ctx incrementNbHandshakes
+    crand <-
+        sendClientHello cparams ctx grps mparams pskinfo
+    --------------------------------
+    -- Receiving ServerHello
+    unless async $ do
+        (ver, hbs, hrr) <- receiveServerHello cparams ctx mparams
+        -- Switching to HRR, TLS 1.2 or TLS 1.3
+        case ver of
+            TLS13
+                | hrr ->
+                    helloRetry cparams ctx mparams ver crand grpsSupported grpsSelected
+                | otherwise -> do
+                    recvServerSecondFlight13 cparams ctx grpsSelected
+                    sendClientSecondFlight13 cparams ctx
+            _
+                | rtt0 ->
+                    throwCore $
+                        Error_Protocol
+                            "server denied TLS 1.3 when connecting with early data"
+                            HandshakeFailure
+                | otherwise -> do
+                    recvServerFirstFlight12 cparams ctx hbs
+                    sendClientSecondFlight12 cparams ctx
+                    recvServerSecondFlight12 cparams ctx
 
-processServerKeyExchange ctx p = processCertificateRequest ctx p
+----------------------------------------------------------------
 
-processCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
-processCertificateRequest ctx (CertRequest cTypes sigAlgs dNames) = do
-    -- When the server requests a client
-    -- certificate, we simply store the
-    -- information for later.
-    --
-    usingHState ctx $ setClientCertRequest (cTypes, sigAlgs, dNames)
-    return $ RecvStateHandshake (processServerHelloDone ctx)
-processCertificateRequest ctx p = processServerHelloDone ctx p
+helloRetry
+    :: ClientParams
+    -> Context
+    -> Maybe a
+    -> Version
+    -> ClientRandom
+    -> [Group]
+    -> [Group]
+    -> IO ()
+helloRetry cparams ctx mparams ver crand groupsSupported groupsSelected = do
+    when (null groupsSupported) $
+        throwCore $
+            Error_Protocol "no supported groups on the client side" IllegalParameter
+    when (isJust mparams) $
+        throwCore $
+            Error_Protocol "server sent too many hello retries" UnexpectedMessage
+    mks <- usingState_ ctx getTLS13KeyShare
+    case mks of
+        Just (KeyShareHRR selectedGroup)
+            -- RFC 8446 Sec 4.1.4: the selected_group MUST be in supported_groups
+            -- and MUST NOT already have been offered in the initial key_share.
+            | selectedGroup `elem` groupsSupported
+                && selectedGroup `notElem` groupsSelected -> do
+                usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest
+                clearTxRecordState ctx
+                let cparams' = cparams{clientUseEarlyData = False}
+                runPacketFlight ctx $ sendChangeCipherSpec13 ctx
+                clientSession <- tls13stSession <$> getTLS13State ctx
+                -- RFC 8446 Sec 4.1.2: the second ClientHello MUST be identical
+                -- to the first except for the specific listed changes.
+                -- supported_groups is NOT on that list, so it must be unchanged.
+                let grps =
+                        Groups
+                            { grpsSupported = groupsSupported
+                            , grpsSelected = [selectedGroup]
+                            }
 
-processServerHelloDone :: Context -> Handshake -> IO (RecvState m)
-processServerHelloDone _ ServerHelloDone = return RecvStateDone
-processServerHelloDone _ p = unexpected (show p) (Just "server hello data")
+                handshake
+                    cparams'
+                    ctx
+                    grps
+                    (Just (crand, clientSession, ver))
+            | selectedGroup `elem` groupsSelected ->
+                throwCore $
+                    Error_Protocol
+                        "server selected a group already offered in key_share"
+                        IllegalParameter
+            | otherwise ->
+                throwCore $
+                    Error_Protocol "server-selected group is not supported" IllegalParameter
+        Just _ -> error "handshake: invalid KeyShare value"
+        Nothing ->
+            throwCore $
+                Error_Protocol
+                    "key exchange not implemented in HRR, expected key_share extension"
+                    HandshakeFailure
diff --git a/Network/TLS/Handshake/Client/ClientHello.hs b/Network/TLS/Handshake/Client/ClientHello.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Client/ClientHello.hs
@@ -0,0 +1,610 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Client.ClientHello (
+    sendClientHello,
+    getPreSharedKeyInfo,
+    Groups (..),
+) where
+
+import qualified Control.Exception as E
+import Crypto.HPKE hiding (CipherText, PlainText)
+import Data.ByteArray (convert)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
+import Network.TLS.ECH.Config
+import System.Random
+
+#if !MIN_VERSION_random(1,3,0)
+import Data.ByteString.Internal (unsafeCreate)
+import Foreign.Ptr
+import Foreign.Storable
+#endif
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Client.Common
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Control
+import Network.TLS.Handshake.Random
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Packet hiding (getExtensions)
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Types
+
+----------------------------------------------------------------
+
+data Groups = Groups
+    { grpsSupported :: [Group]
+    -- ^ For supported_group, head is identical to key_share
+    , grpsSelected :: [Group]
+    -- ^ For key_share
+    }
+    deriving (Eq, Show)
+
+----------------------------------------------------------------
+
+sendClientHello
+    :: ClientParams
+    -> Context
+    -> Groups
+    -> Maybe (ClientRandom, Session, Version)
+    -> PreSharedKeyInfo
+    -> IO ClientRandom
+sendClientHello cparams ctx grps mparams pskinfo = do
+    crand <- generateClientHelloParams mparams -- Inner for ECH
+    sendClientHello' cparams ctx grps crand pskinfo
+    return crand
+  where
+    highestVer = maximum $ supportedVersions $ ctxSupported ctx
+    tls13 = highestVer >= TLS13
+    ems = supportedExtendedMainSecret $ ctxSupported ctx
+
+    -- Client random and session in the second client hello for
+    -- retry must be the same as the first one.
+    generateClientHelloParams (Just (crand, clientSession, _)) = do
+        modifyTLS13State ctx $ \st -> st{tls13stSession = clientSession}
+        return crand
+    generateClientHelloParams Nothing = do
+        crand <- clientRandom ctx
+        let paramSession = case clientSessions cparams of
+                [] -> Session Nothing
+                (sidOrTkt, sdata) : _
+                    | sessionVersion sdata >= TLS13 -> Session Nothing
+                    | ems == RequireEMS && noSessionEMS -> Session Nothing
+                    | isTicket sidOrTkt -> Session $ Just $ toSessionID sidOrTkt
+                    | otherwise -> Session (Just sidOrTkt)
+                  where
+                    noSessionEMS = SessionEMS `notElem` sessionFlags sdata
+        -- In compatibility mode a client not offering a pre-TLS 1.3
+        -- session MUST generate a new 32-byte value
+        if tls13 && paramSession == Session Nothing && not (ctxQUICMode ctx)
+            then do
+                randomSession <- newSession ctx
+                modifyTLS13State ctx $ \st -> st{tls13stSession = randomSession}
+                return crand
+            else do
+                modifyTLS13State ctx $ \st -> st{tls13stSession = paramSession}
+                return crand
+
+----------------------------------------------------------------
+
+sendClientHello'
+    :: ClientParams
+    -> Context
+    -> Groups
+    -> ClientRandom
+    -> ( Maybe ([ByteString], SessionData, CipherChoice, Word32)
+       , Maybe CipherChoice
+       , Bool
+       )
+    -> IO ()
+sendClientHello' cparams ctx Groups{..} crand (pskInfo, rtt0info, rtt0) = do
+    let ver = if tls13 then TLS12 else highestVer
+    clientSession <- tls13stSession <$> getTLS13State ctx
+    hrr <- usingState_ ctx getTLS13HRR
+    unless hrr $ startHandshake ctx ver crand
+    usingState_ ctx $ setVersionIfUnset highestVer
+    let cipherIds = map (CipherId . cipherID) ciphers
+        mkClientHello exts =
+            CH
+                { chVersion = ver
+                , chRandom = crand
+                , chSession = clientSession
+                , chCiphers = cipherIds
+                , chComps = [0]
+                , chExtensions = exts
+                }
+    setMyRecordLimit ctx $ limitRecordSize $ sharedLimit $ ctxShared ctx
+    extensions0 <- catMaybes <$> getExtensions
+    let extensions1 = sharedHelloExtensions (clientShared cparams) ++ extensions0
+    extensions <- adjustPreSharedKeyExt extensions1 $ mkClientHello extensions1
+    let ch0 = mkClientHello extensions
+    updateTranscriptHashI ctx "ClientHelloI" $ encodeHandshake $ ClientHello ch0
+    let nhpks = supportedHPKE $ clientSupported cparams
+        echcnfs = sharedECHConfigList $ clientShared cparams
+        mEchParams = lookupECHConfigList nhpks echcnfs
+    ch <-
+        if clientUseECH cparams
+            then case mEchParams of
+                Nothing -> do
+                    if hrr
+                        then do
+                            (chI, _) <- fromJust <$> usingHState ctx getClientHello
+                            let ch0' = ch0{chExtensions = take 1 (chExtensions chI) ++ drop 1 (chExtensions ch0)}
+                            -- [] will be overridden via
+                            -- encodeUpdateTranscriptHash12
+                            usingHState ctx $ setClientHello ch0' []
+                            return ch0'
+                        else do
+                            gEchExt <- greasingEchExt
+                            let ch0' = ch0{chExtensions = gEchExt : drop 1 (chExtensions ch0)}
+                            -- [] will be overridden via
+                            -- encodeUpdateTranscriptHash12
+                            usingHState ctx $ setClientHello ch0' []
+                            return ch0'
+                Just echParams -> do
+                    let encoded = encodeHandshake $ ClientHello ch0
+                    usingHState ctx $ setClientHello ch0 [encoded]
+                    mcrandO <- usingHState ctx getOuterClientRandom
+                    crandO <- case mcrandO of
+                        Nothing -> clientRandom ctx
+                        Just x -> return x
+                    usingHState ctx $ do
+                        setClientRandom crandO
+                        setOuterClientRandom $ Just crandO
+                    mpskExt <- randomPreSharedKeyExt
+                    createEncryptedClientHello ctx ch0 echParams crandO mpskExt
+            else do
+                -- [] will be overridden via
+                -- encodeUpdateTranscriptHash12
+                usingHState ctx $ setClientHello ch0 []
+                return ch0
+    sendPacket12 ctx $ Handshake [ClientHello ch] []
+    mEarlySecInfo <- case rtt0info of
+        Nothing -> return Nothing
+        Just info -> Just <$> getEarlySecretInfo info
+    unless hrr $ contextSync ctx $ SendClientHello mEarlySecInfo
+    let sentExtensions = map (\(ExtensionRaw i _) -> i) extensions
+    modifyTLS13State ctx $ \st -> st{tls13stSentExtensions = sentExtensions}
+  where
+    ciphers = supportedCiphers $ ctxSupported ctx
+    highestVer = maximum $ supportedVersions $ ctxSupported ctx
+    tls13 = highestVer >= TLS13
+    ems = supportedExtendedMainSecret $ ctxSupported ctx
+
+    -- List of extensions to send in ClientHello, ordered such that we never
+    -- terminate with a zero-length extension.  Some buggy implementations
+    -- are allergic to an extension with empty data at final position.
+    --
+    -- Without TLS 1.3, the list ends with extension "signature_algorithms"
+    -- with length >= 2 bytes.  When TLS 1.3 is enabled, extensions
+    -- "psk_key_exchange_modes" (currently always sent) and "pre_shared_key"
+    -- (not always present) have length > 0.
+    getExtensions =
+        sequence
+            [ {- 0xfe0d -} echExt
+            , {- 0x00 -} sniExt
+            , {- 0x0a -} groupExt
+            , {- 0x0b -} ecPointExt
+            , {- 0x0d -} signatureAlgExt
+            , {- 0x10 -} alpnExt
+            , {- 0x17 -} emsExt
+            , {- 0x1b -} compCertExt
+            , {- 0x1c -} recordSizeLimitExt
+            , {- 0x23 -} sessionTicketExt
+            , {- 0x2a -} earlyDataExt
+            , {- 0x2b -} versionExt
+            , {- 0x2c -} cookieExt
+            , {- 0x2d -} pskExchangeModeExt
+            , {- 0x31 -} postHandshakeAuthExt
+            , {- 0x33 -} keyShareExt
+            , {- 0xff01 -} secureRenegExt
+            , {- 0x29 -} preSharedKeyExt -- MUST be last (RFC 8446)
+            ]
+
+    --------------------
+
+    sniExt =
+        if clientUseServerNameIndication cparams
+            then do
+                let sni = fst $ clientServerIdentification cparams
+                usingState_ ctx $ setClientSNI sni
+                return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName sni]
+            else return Nothing
+
+    -- RFC 8446 Sec 4.2.8 says: Each KeyShareEntry value MUST correspond
+    -- to a group offered in the "supported_groups" extension and MUST
+    -- appear in the same order.
+    groupExt = return $ Just $ toExtensionRaw $ SupportedGroups grpsSupported
+
+    ecPointExt =
+        return $
+            Just $
+                toExtensionRaw $
+                    EcPointFormatsSupported [EcPointFormat_Uncompressed]
+
+    signatureAlgExt =
+        return $
+            Just $
+                toExtensionRaw $
+                    SignatureAlgorithms $
+                        supportedHashSignatures $
+                            clientSupported cparams
+
+    alpnExt = do
+        mprotos <- onSuggestALPN $ clientHooks cparams
+        case mprotos of
+            Nothing -> return Nothing
+            Just protos -> do
+                usingState_ ctx $ setClientALPNSuggest protos
+                return $ Just $ toExtensionRaw $ ApplicationLayerProtocolNegotiation protos
+
+    emsExt =
+        return $
+            if ems == NoEMS || all (>= TLS13) (supportedVersions $ ctxSupported ctx)
+                then Nothing
+                else Just $ toExtensionRaw ExtendedMainSecret
+
+    compCertExt = return $ Just $ toExtensionRaw (CompressCertificate [CCA_Zlib])
+
+    recordSizeLimitExt = case limitRecordSize $ sharedLimit $ ctxShared ctx of
+        Nothing -> return Nothing
+        Just siz -> return $ Just $ toExtensionRaw $ RecordSizeLimit $ fromIntegral siz
+
+    sessionTicketExt =
+        case clientSessions cparams of
+            (sidOrTkt, _) : _
+                | isTicket sidOrTkt -> return $ Just $ toExtensionRaw $ SessionTicket sidOrTkt
+            _   | clientWantTicket cparams -> return $ Just $ toExtensionRaw $ SessionTicket ""
+                | otherwise -> return $ Nothing
+
+    earlyDataExt
+        | rtt0 = return $ Just $ toExtensionRaw (EarlyDataIndication Nothing)
+        | otherwise = return Nothing
+
+    versionExt
+        | clientUseECH cparams = do
+            let vers = supportedVersions $ ctxSupported ctx
+            if TLS13 `elem` vers
+                then
+                    return $ Just $ toExtensionRaw $ SupportedVersionsClientHello [TLS13]
+                else
+                    throwCore $ Error_Misc "TLS 1.3 must be specified for Encrypted Client Hello"
+        | tls13 = do
+            let vers = filter (>= TLS12) $ supportedVersions $ ctxSupported ctx
+            return $ Just $ toExtensionRaw $ SupportedVersionsClientHello vers
+        | otherwise = return Nothing
+
+    cookieExt = do
+        mcookie <- usingState_ ctx getTLS13Cookie
+        case mcookie of
+            Nothing -> return Nothing
+            Just cookie -> return $ Just $ toExtensionRaw cookie
+
+    pskExchangeModeExt
+        | tls13 = return $ Just $ toExtensionRaw $ PskKeyExchangeModes [PSK_DHE_KE]
+        | otherwise = return Nothing
+
+    postHandshakeAuthExt
+        | ctxQUICMode ctx = return Nothing
+        | tls13 = return $ Just $ toExtensionRaw PostHandshakeAuth
+        | otherwise = return Nothing
+
+    keyShareExt
+        | tls13 = do
+            (grpCpris, ents) <- unzip <$> mapM (makeClientKeyShare ctx) grpsSelected
+            usingHState ctx $ setGroupPrivate grpCpris
+            return $ Just $ toExtensionRaw $ KeyShareClientHello ents
+        | otherwise = return Nothing
+
+    secureRenegExt =
+        if supportedSecureRenegotiation $ ctxSupported ctx
+            then do
+                VerifyData cvd <- usingState_ ctx $ getVerifyData ClientRole
+                return $ Just $ toExtensionRaw $ SecureRenegotiation cvd ""
+            else return Nothing
+
+    -- ECHClientHelloInner should be replaced if ECHConfigList is not available.
+    echExt
+        | clientUseECH cparams = return $ Just $ toExtensionRaw ECHClientHelloInner
+        | otherwise = return Nothing
+
+    preSharedKeyExt =
+        case pskInfo of
+            Nothing -> return Nothing
+            Just (identities, _, choice, obfAge) -> do
+                let zero = cZero choice
+                    pskIdentities = map (\x -> PskIdentity x obfAge) identities
+                    -- [zero] is a place holds.
+                    -- adjustPreSharedKeyExt will replace them.
+                    binders = replicate (length pskIdentities) $ convert zero
+                    offeredPsks = PreSharedKeyClientHello pskIdentities binders
+                return $ Just $ toExtensionRaw offeredPsks
+
+    randomPreSharedKeyExt :: IO (Maybe ExtensionRaw)
+    randomPreSharedKeyExt =
+        case pskInfo of
+            Nothing -> return Nothing
+            Just (identities, _, choice, _) -> do
+                let zero = cZero choice
+                zeroR <- getStdRandom $ uniformByteString $ BA.length zero
+                obfAgeR <- getStdRandom genWord32
+                let genPskId x = do
+                        xR <- getStdRandom $ uniformByteString $ B.length x
+                        return $ PskIdentity xR obfAgeR
+                pskIdentitiesR <- mapM genPskId identities
+                let bindersR = replicate (length pskIdentitiesR) zeroR
+                    offeredPsksR = PreSharedKeyClientHello pskIdentitiesR bindersR
+                return $ Just $ toExtensionRaw offeredPsksR
+
+    ----------------------------------------
+
+    adjustPreSharedKeyExt exts ch =
+        case pskInfo of
+            Nothing -> return exts
+            Just (identities, sdata, choice, _) -> do
+                let psk = sessionSecret sdata
+                    earlySecret = initEarlySecret choice (Just psk)
+                usingHState ctx $ setTLS13EarlySecret earlySecret
+                let ech = encodeHandshake $ ClientHello ch
+                    h = cHash choice
+                    siz = (hashDigestSize h + 1) * length identities + 2
+                    binder = makePSKBinder earlySecret h siz ech
+                -- PSK is shared by the previous TLS session.
+                -- So, PSK is unique for identities.
+                let binders = replicate (length identities) binder
+                let exts' = init exts ++ [adjust (last exts)]
+                    adjust (ExtensionRaw eid withoutBinders) = ExtensionRaw eid withBinders
+                      where
+                        withBinders = replacePSKBinder withoutBinders binders
+                return exts'
+
+    getEarlySecretInfo choice = do
+        let usedCipher = cCipher choice
+            usedHash = cHash choice
+        Just earlySecret <- usingHState ctx getTLS13EarlySecret
+        earlyKey <- calculateEarlySecret ctx choice (Right earlySecret)
+        let clientEarlySecret = pairClient earlyKey
+        unless (ctxQUICMode ctx) $ do
+            runPacketFlight ctx $ sendChangeCipherSpec13 ctx
+            setTxRecordState ctx usedHash usedCipher clientEarlySecret
+            setEstablished ctx EarlyDataSending
+        -- We set RTT0Sent even in quicMode
+        usingHState ctx $ setTLS13RTT0Status RTT0Sent
+        return $ EarlySecretInfo usedCipher clientEarlySecret
+
+----------------------------------------------------------------
+
+type PreSharedKeyInfo =
+    ( Maybe ([SessionIDorTicket], SessionData, CipherChoice, Second)
+    , Maybe CipherChoice
+    , Bool
+    )
+
+getPreSharedKeyInfo
+    :: ClientParams
+    -> Context
+    -> IO PreSharedKeyInfo
+getPreSharedKeyInfo cparams ctx = do
+    pskInfo <- getPskInfo
+    let rtt0info = pskInfo >>= get0RTTinfo
+        rtt0 = isJust rtt0info
+    return (pskInfo, rtt0info, rtt0)
+  where
+    ciphers = supportedCiphers $ ctxSupported ctx
+    highestVer = maximum $ supportedVersions $ ctxSupported ctx
+    tls13 = highestVer >= TLS13
+
+    sessions = case clientSessions cparams of
+        [] -> Nothing
+        (sid, sdata) : xs -> do
+            guard tls13
+            guard (sessionVersion sdata >= TLS13)
+            let cid = sessionCipher sdata
+                sids = map fst xs
+            sCipher <- findCipher cid ciphers
+            Just (sid : sids, sdata, sCipher)
+
+    getPskInfo = case sessions of
+        Nothing -> return Nothing
+        Just (identity, sdata, sCipher) -> do
+            let tinfo = fromJust $ sessionTicketInfo sdata
+            age <- getAge tinfo
+            return $
+                if isAgeValid age tinfo
+                    then
+                        Just
+                            ( identity
+                            , sdata
+                            , makeCipherChoice TLS13 sCipher
+                            , ageToObfuscatedAge age tinfo
+                            )
+                    else Nothing
+
+    get0RTTinfo (_, sdata, choice, _)
+        | clientUseEarlyData cparams && sessionMaxEarlyDataSize sdata > 0 = Just choice
+        | otherwise = Nothing
+
+----------------------------------------------------------------
+
+createEncryptedClientHello
+    :: Context
+    -> ClientHello
+    -> (KDF_ID, AEAD_ID, ECHConfig)
+    -> ClientRandom
+    -> Maybe ExtensionRaw
+    -> IO ClientHello
+createEncryptedClientHello ctx ch0@CH{..} echParams@(kdfid, aeadid, conf) crO mpskExt = E.handle hpkeHandler $ do
+    let (chExtsO, chExtsI) = dupCompExts (cnfPublicName conf) mpskExt chExtensions
+        chI =
+            ch0
+                { chSession = Session Nothing
+                , chExtensions = chExtsI
+                }
+    Just (func, enc, taglen) <- getHPKE ctx echParams
+    let bsI = encodeHandshake' $ ClientHello chI
+        padLen = 32 - (B.length bsI .&. 31)
+        bsI' = bsI <> B.replicate padLen 0
+    let outerZ =
+            ECHClientHelloOuter
+                { echCipherSuite = (kdfid, aeadid)
+                , echConfigId = cnfConfigId conf
+                , echEnc = enc
+                , echPayload = B.replicate (B.length bsI' + taglen) 0
+                }
+        echOZ = extensionEncode outerZ
+        chExtsOTail = drop 1 chExtsO
+        chOZ =
+            ch0
+                { chRandom = crO
+                , chExtensions =
+                    ExtensionRaw EID_EncryptedClientHello echOZ : chExtsOTail
+                }
+        aad = encodeHandshake' $ ClientHello chOZ
+    bsO <- func aad bsI'
+    let outer =
+            ECHClientHelloOuter
+                { echCipherSuite = (kdfid, aeadid)
+                , echConfigId = cnfConfigId conf
+                , echEnc = enc
+                , echPayload = bsO
+                }
+        echO = extensionEncode outer
+        chO =
+            chOZ
+                { chExtensions =
+                    ExtensionRaw EID_EncryptedClientHello echO : chExtsOTail
+                }
+    return chO
+  where
+    hpkeHandler :: HPKEError -> IO ClientHello
+    hpkeHandler _ = return ch0
+
+dupCompExts
+    :: HostName
+    -> Maybe ExtensionRaw
+    -> [ExtensionRaw]
+    -> ([ExtensionRaw], [ExtensionRaw]) -- Outer, inner
+dupCompExts host mpskExt chExts = step1 chExts
+  where
+    step1 (echExtI@(ExtensionRaw EID_EncryptedClientHello _) : exts) =
+        (echExtO : os, echExtI : is)
+      where
+        echExtO = ExtensionRaw EID_EncryptedClientHello ""
+        (os, is) = step2 exts
+    step1 _ = error "step1"
+    step2 (sniExtI@(ExtensionRaw EID_ServerName _) : exts) =
+        (sniExtO : os, sniExtI : is)
+      where
+        sniExtO = toExtensionRaw $ ServerName [ServerNameHostName host]
+        (os, is) = step3 exts id
+    step2 _ = error "step2"
+    step3 [] build = ([], [echOuterExt])
+      where
+        echOuterExt = toExtensionRaw $ EchOuterExtensions $ build []
+    step3 [pskExtI@(ExtensionRaw EID_PreSharedKey _)] build =
+        ([pskExtO], [echOuterExt, pskExtI])
+      where
+        echOuterExt = toExtensionRaw $ EchOuterExtensions $ build []
+        pskExtO = fromJust mpskExt
+    step3 (i@(ExtensionRaw eid _) : is) build = (i : os', is')
+      where
+        (os', is') = step3 is (build . (eid :))
+
+getHPKE
+    :: Context
+    -> (KDF_ID, AEAD_ID, ECHConfig)
+    -> IO (Maybe (AAD -> PlainText -> IO CipherText, EncodedPublicKey, Int))
+getHPKE ctx (kdfid, aeadid, conf) = do
+    mfunc <- getTLS13HPKE ctx
+    case mfunc of
+        Nothing -> do
+            let encodedConfig = encodeECHConfig conf
+                info = "tls ech\x00" <> encodedConfig
+            (pkSm, ctxS) <- setupBaseS kemid kdfid aeadid Nothing Nothing mpkR info
+            let func = seal ctxS
+            setTLS13HPKE ctx func 0
+            return $ Just (func, pkSm, nT)
+        Just (func, _) -> return $ Just (func, EncodedPublicKey "", nT)
+  where
+    mpkR = cnfEncodedPublicKey conf
+    kemid = cnfKemId conf
+    nT = nTag aeadid
+
+----------------------------------------------------------------
+
+lookupECHConfigList
+    :: [(KEM_ID, KDF_ID, AEAD_ID)]
+    -> ECHConfigList
+    -> Maybe (KDF_ID, AEAD_ID, ECHConfig)
+lookupECHConfigList [] _ = Nothing
+lookupECHConfigList ((kemid, kdfid, aeadid) : xs) cnfs =
+    case find (\cnf -> cnfKemId cnf == kemid) cnfs of
+        Nothing -> lookupECHConfigList xs cnfs
+        Just cnf
+            | (kdfid, aeadid) `elem` cnfCipherSuite cnf ->
+                Just (kdfid, aeadid, cnf)
+            | otherwise -> lookupECHConfigList xs cnfs
+
+cnfKemId :: ECHConfig -> KEM_ID
+cnfKemId ECHConfig{..} = KEM_ID $ kem_id $ key_config contents
+
+cnfCipherSuite :: ECHConfig -> [(KDF_ID, AEAD_ID)]
+cnfCipherSuite ECHConfig{..} = map conv $ cipher_suites $ key_config contents
+  where
+    conv HpkeSymmetricCipherSuite{..} = (KDF_ID kdf_id, AEAD_ID aead_id)
+
+cnfEncodedPublicKey :: ECHConfig -> EncodedPublicKey
+cnfEncodedPublicKey ECHConfig{..} = EncodedPublicKey pk
+  where
+    EncodedServerPublicKey pk = public_key $ key_config contents
+
+cnfPublicName :: ECHConfig -> HostName
+cnfPublicName ECHConfig{..} = public_name contents
+
+cnfConfigId :: ECHConfig -> ConfigId
+cnfConfigId ECHConfig{..} = config_id $ key_config contents
+
+----------------------------------------------------------------
+
+-- Pretending X25519 is used because it is the de-facto and
+-- its public key is easily created.
+greasingEchExt :: IO ExtensionRaw
+greasingEchExt = do
+    cid <- getStdRandom genWord8
+    enc <- getStdRandom $ uniformByteString 32
+    n <- getStdRandom $ randomR (4, 6)
+    payload <- getStdRandom $ uniformByteString (n * 32 + 16)
+    let outer =
+            ECHClientHelloOuter
+                { echCipherSuite = (HKDF_SHA256, AES_128_GCM)
+                , echConfigId = cid
+                , echEnc = EncodedPublicKey enc
+                , echPayload = payload
+                }
+    return $ toExtensionRaw outer
+
+#if !MIN_VERSION_random(1,3,0)
+uniformByteString :: RandomGen g => Int -> g -> (ByteString, g)
+uniformByteString l g0 = (bs, g2)
+  where
+    (g1, g2) = split g0
+    bs = unsafeCreate l $ go 0 g1
+    go n g ptr
+        | n == l = return ()
+        | otherwise = do
+            let (w, g') = genWord8 g
+            poke ptr w
+            go (n + 1) g' (plusPtr ptr 1)
+#endif
diff --git a/Network/TLS/Handshake/Client/Common.hs b/Network/TLS/Handshake/Client/Common.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Client/Common.hs
@@ -0,0 +1,363 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Client.Common (
+    throwMiscErrorOnException,
+    doServerKeyExchange,
+    doCertificate,
+    getLocalHashSigAlg,
+    clientChain,
+    sigAlgsToCertTypes,
+    setALPN,
+    contextSync,
+    clientSessions,
+) where
+
+import Control.Exception (SomeException)
+import Control.Monad.State.Strict
+import Data.X509 (ExtKeyUsageFlag (..))
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Credentials
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Certificate
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Control
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Packet hiding (getExtensions)
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Util (catchException)
+import Network.TLS.X509
+
+----------------------------------------------------------------
+
+throwMiscErrorOnException :: String -> SomeException -> IO a
+throwMiscErrorOnException msg e =
+    throwCore $ Error_Misc $ msg ++ ": " ++ show e
+
+----------------------------------------------------------------
+
+doServerKeyExchange :: Context -> ServerKeyXchgAlgorithmData -> IO ()
+doServerKeyExchange ctx origSkx = do
+    cipher <- usingHState ctx getPendingCipher
+    processWithCipher cipher origSkx
+  where
+    processWithCipher cipher skx =
+        case (cipherKeyExchange cipher, skx) of
+            (CipherKeyExchange_DHE_RSA, SKX_DHE_RSA dhparams signature) ->
+                doDHESignature dhparams signature KX_RSA
+            (CipherKeyExchange_DHE_DSA, SKX_DHE_DSA dhparams signature) ->
+                doDHESignature dhparams signature KX_DSA
+            (CipherKeyExchange_ECDHE_RSA, SKX_ECDHE_RSA ecdhparams signature) ->
+                doECDHESignature ecdhparams signature KX_RSA
+            (CipherKeyExchange_ECDHE_ECDSA, SKX_ECDHE_ECDSA ecdhparams signature) ->
+                doECDHESignature ecdhparams signature KX_ECDSA
+            (cke, SKX_Unparsed bytes) -> do
+                ver <- usingState_ ctx getVersion
+                case decodeReallyServerKeyXchgAlgorithmData ver cke bytes of
+                    Left _ ->
+                        throwCore $
+                            Error_Protocol
+                                ("unknown server key exchange received, expecting: " ++ show cke)
+                                HandshakeFailure
+                    Right realSkx -> processWithCipher cipher realSkx
+            -- we need to resolve the result. and recall processWithCipher ..
+            (c, _) ->
+                throwCore $
+                    Error_Protocol
+                        ("unknown server key exchange received, expecting: " ++ show c)
+                        HandshakeFailure
+    doDHESignature dhparams signature kxsAlg = do
+        -- FF group selected by the server is verified when generating CKX
+        publicKey <- getSignaturePublicKey kxsAlg
+        verified <- digitallySignDHParamsVerify ctx dhparams publicKey signature
+        unless verified $
+            decryptError
+                ("bad " ++ pubkeyType publicKey ++ " signature for dhparams " ++ show dhparams)
+        usingHState ctx $ setServerDHParams dhparams
+
+    doECDHESignature ecdhparams signature kxsAlg = do
+        -- EC group selected by the server is verified when generating CKX
+        publicKey <- getSignaturePublicKey kxsAlg
+        verified <- digitallySignECDHParamsVerify ctx ecdhparams publicKey signature
+        unless verified $
+            decryptError ("bad " ++ pubkeyType publicKey ++ " signature for ecdhparams")
+        usingHState ctx $ setServerECDHParams ecdhparams
+
+    getSignaturePublicKey kxsAlg = do
+        publicKey <- usingHState ctx getRemotePublicKey
+        unless (isKeyExchangeSignatureKey kxsAlg publicKey) $
+            throwCore $
+                Error_Protocol
+                    ("server public key algorithm is incompatible with " ++ show kxsAlg)
+                    HandshakeFailure
+        ver <- usingState_ ctx getVersion
+        unless (publicKey `versionCompatible` ver) $
+            throwCore $
+                Error_Protocol
+                    (show ver ++ " has no support for " ++ pubkeyType publicKey)
+                    IllegalParameter
+        let groups = supportedGroups (ctxSupported ctx)
+        unless (satisfiesEcPredicate (`elem` groups) publicKey) $
+            throwCore $
+                Error_Protocol
+                    "server public key has unsupported elliptic curve"
+                    IllegalParameter
+        return publicKey
+
+----------------------------------------------------------------
+
+doCertificate :: ClientParams -> Context -> CertificateChain -> IO ()
+doCertificate cparams ctx certs = do
+    when (isNullCertificateChain certs) $
+        throwCore $
+            Error_Protocol "server certificate missing" DecodeError
+    -- run certificate recv hook
+    ctxWithHooks ctx (`hookRecvCertificates` certs)
+    -- then run certificate validation
+    usage <- catchException (wrapCertificateChecks <$> checkCert) rejectOnException
+    case usage of
+        CertificateUsageAccept -> checkLeafCertificateKeyUsage
+        CertificateUsageReject reason -> certificateRejected reason
+  where
+    shared = clientShared cparams
+    checkCert =
+        onServerCertificate
+            (clientHooks cparams)
+            (sharedCAStore shared)
+            (sharedValidationCache shared)
+            (clientServerIdentification cparams)
+            certs
+    -- also verify that the certificate optional key usage is compatible
+    -- with the intended key-exchange.  This check is not delegated to
+    -- x509-validation 'checkLeafKeyUsage' because it depends on negotiated
+    -- cipher, which is not available from onServerCertificate parameters.
+    -- Additionally, with only one shared ValidationCache, x509-validation
+    -- would cache validation result based on a key usage and reuse it with
+    -- another key usage.
+    checkLeafCertificateKeyUsage = do
+        cipher <- usingHState ctx getPendingCipher
+        case requiredCertKeyUsage cipher of
+            [] -> return ()
+            flags -> verifyLeafKeyUsage flags certs
+
+-- Unless result is empty, server certificate must be allowed for at least one
+-- of the returned values.  Constraints for RSA-based key exchange are relaxed
+-- to avoid rejecting certificates having incomplete extension.
+requiredCertKeyUsage :: Cipher -> [ExtKeyUsageFlag]
+requiredCertKeyUsage cipher =
+    case cipherKeyExchange cipher of
+        CipherKeyExchange_RSA -> rsaCompatibility
+        CipherKeyExchange_DH_Anon -> [] -- unrestricted
+        CipherKeyExchange_DHE_RSA -> rsaCompatibility
+        CipherKeyExchange_ECDHE_RSA -> rsaCompatibility
+        CipherKeyExchange_DHE_DSA -> [KeyUsage_digitalSignature]
+        CipherKeyExchange_DH_DSA -> [KeyUsage_keyAgreement]
+        CipherKeyExchange_DH_RSA -> rsaCompatibility
+        CipherKeyExchange_ECDH_ECDSA -> [KeyUsage_keyAgreement]
+        CipherKeyExchange_ECDH_RSA -> rsaCompatibility
+        CipherKeyExchange_ECDHE_ECDSA -> [KeyUsage_digitalSignature]
+        CipherKeyExchange_TLS13 -> [KeyUsage_digitalSignature]
+  where
+    rsaCompatibility =
+        [ KeyUsage_digitalSignature
+        , KeyUsage_keyEncipherment
+        , KeyUsage_keyAgreement
+        ]
+
+----------------------------------------------------------------
+
+-- | Return the supported 'CertificateType' values that are
+-- compatible with at least one supported signature algorithm.
+supportedCtypes
+    :: [HashAndSignatureAlgorithm]
+    -> [CertificateType]
+supportedCtypes hashAlgs =
+    nub $ foldr ctfilter [] hashAlgs
+  where
+    ctfilter x acc = case hashSigToCertType x of
+        Just cType
+            | cType <= lastSupportedCertificateType ->
+                cType : acc
+        _ -> acc
+
+clientSupportedCtypes
+    :: Context
+    -> [CertificateType]
+clientSupportedCtypes ctx =
+    supportedCtypes $ supportedHashSignatures $ ctxSupported ctx
+
+sigAlgsToCertTypes
+    :: Context
+    -> [HashAndSignatureAlgorithm]
+    -> [CertificateType]
+sigAlgsToCertTypes ctx hashSigs =
+    filter (`elem` supportedCtypes hashSigs) $ clientSupportedCtypes ctx
+
+----------------------------------------------------------------
+
+-- | When the server requests a client certificate, we try to
+-- obtain a suitable certificate chain and private key via the
+-- callback in the client parameters.  It is OK for the callback
+-- to return an empty chain, in many cases the client certificate
+-- is optional.  If the client wishes to abort the handshake for
+-- lack of a suitable certificate, it can throw an exception in
+-- the callback.
+--
+-- The return value is 'Nothing' when no @CertificateRequest@ was
+-- received and no @Certificate@ message needs to be sent. An empty
+-- chain means that an empty @Certificate@ message needs to be sent
+-- to the server, naturally without a @CertificateVerify@.  A non-empty
+-- 'CertificateChain' is the chain to send to the server along with
+-- a corresponding 'CertificateVerify'.
+--
+-- With TLS < 1.2 the server's @CertificateRequest@ does not carry
+-- a signature algorithm list.  It has a list of supported public
+-- key signing algorithms in the @certificate_types@ field.  The
+-- hash is implicit.  It is 'SHA1' for DSA and 'SHA1_MD5' for RSA.
+--
+-- With TLS == 1.2 the server's @CertificateRequest@ always has a
+-- @supported_signature_algorithms@ list, as a fixed component of
+-- the structure.  This list is (wrongly) overloaded to also limit
+-- X.509 signatures in the client's certificate chain.  The BCP
+-- strategy is to find a compatible chain if possible, but else
+-- ignore the constraint, and let the server verify the chain as it
+-- sees fit.  The @supported_signature_algorithms@ field is only
+-- obligatory with respect to signatures on TLS messages, in this
+-- case the @CertificateVerify@ message.  The @certificate_types@
+-- field is still included.
+--
+-- With TLS 1.3 the server's @CertificateRequest@ has a mandatory
+-- @signature_algorithms@ extension, the @signature_algorithms_cert@
+-- extension, which is optional, carries a list of algorithms the
+-- server promises to support in verifying the certificate chain.
+-- As with TLS 1.2, the client's makes a /best-effort/ to deliver
+-- a compatible certificate chain where all the CA signatures are
+-- known to be supported, but it should not abort the connection
+-- just because the chain might not work out, just send the best
+-- chain you have and let the server worry about the rest.  The
+-- supported public key algorithms are now inferred from the
+-- @signature_algorithms@ extension and @certificate_types@ is
+-- gone.
+--
+-- With TLS 1.3, we synthesize and store a @certificate_types@
+-- field at the time that the server's @CertificateRequest@
+-- message is received.  This is then present across all the
+-- protocol versions, and can be used to determine whether
+-- a @CertificateRequest@ was received or not.
+--
+-- If @signature_algorithms@ is 'Nothing', then we're doing
+-- TLS 1.0 or 1.1.  The @signature_algorithms_cert@ extension
+-- is optional in TLS 1.3, and so the application callback
+-- will not be able to distinguish between TLS 1.[01] and
+-- TLS 1.3 with no certificate algorithm hints, but this
+-- just simplifies the chain selection process, all CA
+-- signatures are OK.
+clientChain :: ClientParams -> Context -> IO (Maybe CertificateChain)
+clientChain cparams ctx =
+    usingHState ctx getCertReqCBdata >>= \case
+        Nothing -> return Nothing
+        Just cbdata -> do
+            let callback = onCertificateRequest $ clientHooks cparams
+            chain <-
+                liftIO $
+                    callback cbdata
+                        `catchException` throwMiscErrorOnException "certificate request callback failed"
+            case chain of
+                Nothing ->
+                    return $ Just $ CertificateChain []
+                Just (CertificateChain [], _) ->
+                    return $ Just $ CertificateChain []
+                Just cred@(cc, _) ->
+                    do
+                        let (cTypes, _, _) = cbdata
+                        storePrivInfoClient ctx cTypes cred
+                        return $ Just cc
+
+-- | Store the keypair and check that it is compatible with the current protocol
+-- version and a list of 'CertificateType' values.
+storePrivInfoClient
+    :: Context
+    -> [CertificateType]
+    -> Credential
+    -> IO ()
+storePrivInfoClient ctx cTypes (cc, privkey) = do
+    pubkey <- storePrivInfo ctx cc privkey
+    unless (certificateCompatible pubkey cTypes) $
+        throwCore $
+            Error_Protocol
+                (pubkeyType pubkey ++ " credential does not match allowed certificate types")
+                InternalError
+    ver <- usingState_ ctx getVersion
+    unless (pubkey `versionCompatible` ver) $
+        throwCore $
+            Error_Protocol
+                (pubkeyType pubkey ++ " credential is not supported at version " ++ show ver)
+                InternalError
+
+----------------------------------------------------------------
+
+-- | Return a most preferred 'HandAndSignatureAlgorithm' that is compatible with
+-- the local key and server's signature algorithms (both already saved).  Must
+-- only be called for TLS versions 1.2 and up, with compatibility function
+-- 'signatureCompatible' or 'signatureCompatible13' based on version.
+--
+-- The values in the server's @signature_algorithms@ extension are
+-- in descending order of preference.  However here the algorithms
+-- are selected by client preference in @cHashSigs@.
+getLocalHashSigAlg
+    :: Context
+    -> (PubKey -> HashAndSignatureAlgorithm -> Bool)
+    -> [HashAndSignatureAlgorithm]
+    -> PubKey
+    -> IO HashAndSignatureAlgorithm
+getLocalHashSigAlg ctx isCompatible cHashSigs pubKey = do
+    -- Must be present with TLS 1.2 and up.
+    (Just (_, Just hashSigs, _)) <- usingHState ctx getCertReqCBdata
+    let want =
+            (&&)
+                <$> isCompatible pubKey
+                <*> flip elem hashSigs
+    case find want cHashSigs of
+        Just best -> return best
+        Nothing -> throwCore $ Error_Protocol (keyerr pubKey) HandshakeFailure
+  where
+    keyerr k = "no " ++ pubkeyType k ++ " hash algorithm in common with the server"
+
+----------------------------------------------------------------
+
+setALPN :: Context -> MessageType -> [ExtensionRaw] -> IO ()
+setALPN ctx msgt exts =
+    lookupAndDecodeAndDo
+        EID_ApplicationLayerProtocolNegotiation
+        msgt
+        exts
+        (return ())
+        setAlpn
+  where
+    setAlpn (ApplicationLayerProtocolNegotiation [proto]) = usingState_ ctx $ do
+        mprotos <- getClientALPNSuggest
+        case mprotos of
+            Just protos -> when (proto `elem` protos) $ do
+                setExtensionALPN True
+                setNegotiatedProtocol proto
+            _ -> return ()
+    setAlpn _ = return ()
+
+----------------------------------------------------------------
+
+contextSync :: Context -> ClientState -> IO ()
+contextSync ctx ctl = case ctxHandshakeSync ctx of
+    HandshakeSync sync _ -> sync ctx ctl
+
+clientSessions :: ClientParams -> [(SessionID, SessionData)]
+clientSessions ClientParams{..} = case clientWantSessionResume of
+    Nothing -> clientWantSessionResumeList
+    Just ent -> clientWantSessionResumeList ++ [ent]
diff --git a/Network/TLS/Handshake/Client/ServerHello.hs b/Network/TLS/Handshake/Client/ServerHello.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Client/ServerHello.hs
@@ -0,0 +1,306 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Client.ServerHello (
+    receiveServerHello,
+    processServerHello13,
+) where
+
+import Data.ByteArray (convert)
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Compression
+import Network.TLS.Context.Internal
+import Network.TLS.ErrT
+import Network.TLS.Extension
+import Network.TLS.Handshake.Client.Common
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Random
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+
+----------------------------------------------------------------
+
+receiveServerHello
+    :: ClientParams
+    -> Context
+    -> Maybe (ClientRandom, Session, Version)
+    -> IO (Version, [HandshakeR], Bool)
+receiveServerHello cparams ctx mparams = do
+    chSentTime <- getCurrentTimeFromBase
+    (shb@(sh, _), hbs) <- recvSH
+    processServerHello cparams ctx sh
+    updateTranscriptHash12 ctx shb
+    setRTT ctx chSentTime
+    ver <- usingState_ ctx getVersion
+    unless (maybe True (\(_, _, v) -> v == ver) mparams) $
+        throwCore $
+            Error_Protocol "version changed after hello retry" IllegalParameter
+    -- recvServerHello sets TLS13HRR according to the server random.
+    -- For 1st server hello, getTLS13HR returns True if it is HRR and
+    -- False otherwise.  For 2nd server hello, getTLS13HR returns
+    -- False since it is NOT HRR.
+    hrr <- usingState_ ctx getTLS13HRR
+    return (ver, hbs, hrr)
+  where
+    recvSH = do
+        epkt <- recvPacket12 ctx
+        case epkt of
+            Left e -> throwCore e
+            Right pkt -> case pkt of
+                Alert a -> throwAlert a
+                Handshake (h : hs) (b : bs) -> return ((h, b), zip hs bs)
+                _ -> unexpected (show pkt) (Just "handshake")
+    throwAlert a =
+        throwCore $
+            Error_Protocol
+                ("expecting server hello, got alert : " ++ show a)
+                HandshakeFailure
+
+----------------------------------------------------------------
+
+processServerHello13
+    :: ClientParams -> Context -> Handshake13 -> IO ()
+processServerHello13 cparams ctx (ServerHello13 sh13) = do
+    let sh12 = ServerHello sh13
+    processServerHello cparams ctx sh12
+processServerHello13 _ _ h = unexpected (show h) (Just "server hello")
+
+-- | processServerHello processes the ServerHello message on the client.
+--
+-- 1) check the version chosen by the server is one allowed by
+--    parameters.
+-- 2) check that our compression and cipher algorithms are part of the
+--    list we sent
+-- 3) check extensions received are part of the one we sent
+-- 4) process the session parameter to see if the server want to start
+--    a new session or can resume
+processServerHello
+    :: ClientParams -> Context -> Handshake -> IO ()
+processServerHello cparams ctx (ServerHello sh@SH{..}) = do
+    -- A server which receives a legacy_version value not equal to
+    -- 0x0303 MUST abort the handshake with an "illegal_parameter"
+    -- alert.
+    when (shVersion /= TLS12) $
+        throwCore $
+            Error_Protocol (show shVersion ++ " is not supported") IllegalParameter
+    -- find the compression and cipher methods that the server want to use.
+    clientSession <- tls13stSession <$> getTLS13State ctx
+    chExts <- tls13stSentExtensions <$> getTLS13State ctx
+    let clientCiphers = supportedCiphers $ ctxSupported ctx
+    usedCipher <- case findCipher (fromCipherId shCipher) clientCiphers of
+        Nothing -> throwCore $ Error_Protocol "server choose unknown cipher" IllegalParameter
+        Just alg -> return alg
+    compressAlg <- case find
+        ((==) shComp . compressionID)
+        (supportedCompressions $ ctxSupported ctx) of
+        Nothing ->
+            throwCore $ Error_Protocol "server choose unknown compression" IllegalParameter
+        Just alg -> return alg
+    ensureNullCompression shComp
+
+    -- intersect sent extensions in client and the received extensions
+    -- from server.  if server returns extensions that we didn't
+    -- request, fail.
+    let checkExt (ExtensionRaw i _)
+            | i == EID_Cookie = False -- for HRR
+            | otherwise = i `notElem` chExts
+    when (any checkExt shExtensions) $
+        throwCore $
+            Error_Protocol "spurious extensions received" UnsupportedExtension
+
+    let isHRR = isHelloRetryRequest shRandom
+    usingState_ ctx $ do
+        setTLS13HRR isHRR
+        when isHRR $
+            setTLS13Cookie $
+                lookupAndDecode
+                    EID_Cookie
+                    MsgTServerHello
+                    shExtensions
+                    Nothing
+                    (\cookie@(Cookie _) -> Just cookie)
+        setVersion shVersion -- must be before processing supportedVersions ext
+        mapM_ processServerExtension shExtensions
+
+    setALPN ctx MsgTServerHello shExtensions
+
+    ver <- usingState_ ctx getVersion
+
+    when (ver == TLS12) $
+        setServerHelloParameters12 ctx shVersion shRandom usedCipher compressAlg
+
+    let supportedVers = supportedVersions $ clientSupported cparams
+
+    when (ver == TLS13) $ do
+        -- TLS 1.3 server MUST echo the session id
+        when (clientSession /= shSession) $
+            throwCore $
+                Error_Protocol
+                    "session is not matched in compatibility mode"
+                    IllegalParameter
+        when (ver `notElem` supportedVers) $
+            throwCore $
+                Error_Protocol
+                    ("server version " ++ show ver ++ " is not supported")
+                    ProtocolVersion
+
+    -- Some servers set TLS 1.2 as the legacy server hello version,
+    -- and TLS 1.3 in the supported_versions extension, *AND ALSO* set
+    -- the TLS 1.2 downgrade signal in the server random.  If we
+    -- support TLS 1.3 and actually negotiate TLS 1.3, we must ignore
+    -- the server random downgrade signal.  Therefore, 'isDowngraded'
+    -- needs to take into account the negotiated version and the
+    -- server random, as well as the list of client-side enabled
+    -- protocol versions.
+    --
+    when (isDowngraded ver supportedVers shRandom) $
+        throwCore $
+            Error_Protocol "version downgrade detected" IllegalParameter
+
+    if ver == TLS13
+        then do
+            -- Session is dummy in TLS 1.3.
+            usingState_ ctx $ setSession shSession
+            processRecordSizeLimit ctx shExtensions True
+            enableMyRecordLimit ctx
+            enablePeerRecordLimit ctx
+            let usedHash = cipherHash usedCipher
+            transitTranscriptHashI ctx "transitI" usedHash isHRR
+            accepted <- checkECHacceptance ctx isHRR usedHash sh
+            when accepted $ do
+                (CH{..}, _b) <- fromJust <$> usingHState ctx getClientHello
+                usingHState ctx $ setClientRandom chRandom -- inner random
+            when (accepted && not isHRR) $ do
+                copyTranscriptHash ctx "copy"
+                usingHState ctx $ setECHAccepted True
+            updateContext13 ctx usedCipher isHRR
+            updateTranscriptHashI ctx "ServerHelloI" $ encodeHandshake $ ServerHello sh
+        else do
+            let resumingSession = case clientSessions cparams of
+                    (_, sessionData) : _ ->
+                        if shSession == clientSession then Just sessionData else Nothing
+                    _ -> Nothing
+
+            usingState_ ctx $ do
+                setSession shSession
+                setTLS12SessionResuming $ isJust resumingSession
+            processRecordSizeLimit ctx shExtensions False
+            updateContext12 ctx shExtensions resumingSession
+processServerHello _ _ p = unexpected (show p) (Just "server hello")
+
+----------------------------------------------------------------
+
+processServerExtension :: ExtensionRaw -> TLSSt ()
+processServerExtension (ExtensionRaw extID content)
+    | extID == EID_SecureRenegotiation = do
+        VerifyData cvd <- getVerifyData ClientRole
+        VerifyData svd <- getVerifyData ServerRole
+        let bs = extensionEncode $ SecureRenegotiation cvd svd
+        unless (bs == content) $
+            throwError $
+                Error_Protocol "server secure renegotiation data not matching" HandshakeFailure
+    | extID == EID_SupportedVersions = case extensionDecode MsgTServerHello content of
+        Just (SupportedVersionsServerHello ver) -> setVersion ver
+        _ -> return ()
+    | extID == EID_KeyShare = do
+        hrr <- getTLS13HRR
+        let msgt = if hrr then MsgTHelloRetryRequest else MsgTServerHello
+        setTLS13KeyShare $ extensionDecode msgt content
+    | extID == EID_PreSharedKey =
+        setTLS13PreSharedKey $ extensionDecode MsgTServerHello content
+    | extID == EID_SessionTicket = setTLS12SessionTicket "" -- empty ticket
+processServerExtension _ = return ()
+
+----------------------------------------------------------------
+
+updateContext13 :: Context -> Cipher -> Bool -> IO ()
+updateContext13 ctx usedCipher isHRR = do
+    established <- ctxEstablished ctx
+    eof <- ctxEOF ctx
+    when (established == Established && not eof) $
+        throwCore $
+            Error_Protocol
+                "renegotiation to TLS 1.3 or later is not allowed"
+                ProtocolVersion
+    failOnEitherError $ setServerHelloParameters13 ctx usedCipher isHRR
+
+updateContext12 :: Context -> [ExtensionRaw] -> Maybe SessionData -> IO ()
+updateContext12 ctx shExtensions resumingSession = do
+    ems <- processExtendedMainSecret ctx TLS12 MsgTServerHello shExtensions
+    case resumingSession of
+        Nothing -> return ()
+        Just sessionData -> do
+            let emsSession = SessionEMS `elem` sessionFlags sessionData
+            when (ems /= emsSession) $
+                let err = "server resumes a session which is not EMS consistent"
+                 in throwCore $ Error_Protocol err HandshakeFailure
+            let mainSecret = convert $ sessionSecret sessionData
+            usingHState ctx $ setMainSecret TLS12 ClientRole mainSecret
+            logKey ctx (MainSecret mainSecret)
+
+----------------------------------------------------------------
+
+processRecordSizeLimit
+    :: Context -> [ExtensionRaw] -> Bool -> IO ()
+processRecordSizeLimit ctx shExtensions tls13 = do
+    let mmylim = limitRecordSize $ sharedLimit $ ctxShared ctx
+    case mmylim of
+        Nothing -> return ()
+        Just mylim -> do
+            lookupAndDecodeAndDo
+                EID_RecordSizeLimit
+                MsgTClientHello
+                shExtensions
+                (return ())
+                (setPeerRecordSizeLimit ctx tls13)
+            ack <- checkPeerRecordLimit ctx
+            -- When a client sends RecordSizeLimit, it does not know
+            -- which TLS version the server selects.  RecordLimit is
+            -- the length of plaintext.  But RecordSizeLimit also
+            -- includes CT: and padding for TLS 1.3.  To convert
+            -- RecordSizeLimit to RecordLimit, we should reduce the
+            -- value by 1, which is the length of CT:.
+            when (ack && tls13) $ setMyRecordLimit ctx $ Just (mylim - 1)
+
+----------------------------------------------------------------
+
+checkECHacceptance :: Context -> Bool -> Hash -> ServerHello -> IO Bool
+checkECHacceptance ctx False usedHash sh@SH{..} = do
+    let (prefix, confirm) = B.splitAt 24 $ unServerRandom shRandom
+        sr' = ServerRandom (prefix <> "\x00\x00\x00\x00\x00\x00\x00\x00")
+    verified <-
+        computeConfirm ctx usedHash sh{shRandom = sr'} "ech accept confirmation"
+    return (confirm == verified)
+checkECHacceptance ctx True usedHash sh@SH{..} = do
+    case replace shExtensions of
+        Nothing -> return False
+        Just (confirm, shExts') -> do
+            verified <-
+                computeConfirm
+                    ctx
+                    usedHash
+                    sh{shExtensions = shExts'}
+                    "hrr ech accept confirmation"
+            return (confirm == verified)
+  where
+    replace [] = Nothing
+    replace (ExtensionRaw EID_EncryptedClientHello confirm : es) =
+        Just
+            ( confirm
+            , ExtensionRaw EID_EncryptedClientHello "\x00\x00\x00\x00\x00\x00\x00\x00" : es
+            )
+    replace (e : es) = case replace es of
+        Nothing -> Nothing
+        Just (confirm, es') -> Just (confirm, e : es')
diff --git a/Network/TLS/Handshake/Client/TLS12.hs b/Network/TLS/Handshake/Client/TLS12.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Client/TLS12.hs
@@ -0,0 +1,288 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.Client.TLS12 (
+    recvServerFirstFlight12,
+    sendClientSecondFlight12,
+    recvServerSecondFlight12,
+) where
+
+import Control.Monad.State.Strict
+import Data.ByteArray (convert)
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import Network.TLS.Handshake.Client.Common
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Packet hiding (getExtensions, getSession)
+import Network.TLS.Parameters
+import Network.TLS.Session
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Types
+import Network.TLS.Util (catchException)
+import Network.TLS.Wire
+import Network.TLS.X509 hiding (Certificate)
+
+----------------------------------------------------------------
+
+recvServerFirstFlight12
+    :: ClientParams -> Context -> [HandshakeR] -> IO ()
+recvServerFirstFlight12 cparams ctx hbs = do
+    resuming <- usingState_ ctx getTLS12SessionResuming
+    if resuming
+        then recvNSTandCCSandFinished ctx
+        else do
+            let st = RecvStateHandshake (expectCertificate cparams ctx)
+            runRecvStateHS ctx st hbs
+
+expectCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO)
+expectCertificate cparams ctx (Certificate (CertificateChain_ certs)) = do
+    usingState_ ctx $ setServerCertificateChain certs
+    doCertificate cparams ctx certs
+    processCertificate ctx ClientRole certs
+    return $ RecvStateHandshake (expectServerKeyExchange ctx)
+expectCertificate _ ctx p = expectServerKeyExchange ctx p
+
+expectServerKeyExchange :: Context -> Handshake -> IO (RecvState IO)
+expectServerKeyExchange ctx (ServerKeyXchg origSkx) = do
+    doServerKeyExchange ctx origSkx
+    return $ RecvStateHandshake (expectCertificateRequest ctx)
+expectServerKeyExchange ctx p = expectCertificateRequest ctx p
+
+expectCertificateRequest :: Context -> Handshake -> IO (RecvState IO)
+expectCertificateRequest ctx (CertRequest cTypesSent sigAlgs dNames) = do
+    let cTypes = filter (<= lastSupportedCertificateType) cTypesSent
+    usingHState ctx $ setCertReqCBdata $ Just (cTypes, Just sigAlgs, dNames)
+    return $ RecvStateHandshake (expectServerHelloDone ctx)
+expectCertificateRequest ctx p = do
+    usingHState ctx $ setCertReqCBdata Nothing
+    expectServerHelloDone ctx p
+
+expectServerHelloDone :: Context -> Handshake -> IO (RecvState m)
+expectServerHelloDone _ ServerHelloDone = return RecvStateDone
+expectServerHelloDone _ p = unexpected (show p) (Just "server hello data")
+
+----------------------------------------------------------------
+
+sendClientSecondFlight12 :: ClientParams -> Context -> IO ()
+sendClientSecondFlight12 cparams ctx = do
+    sessionResuming <- usingState_ ctx getTLS12SessionResuming
+    if sessionResuming
+        then sendCCSandFinished ctx ClientRole
+        else do
+            sendClientCCC cparams ctx
+            sendCCSandFinished ctx ClientRole
+
+recvServerSecondFlight12 :: ClientParams -> Context -> IO ()
+recvServerSecondFlight12 cparams ctx = do
+    sessionResuming <- usingState_ ctx getTLS12SessionResuming
+    unless sessionResuming $ recvNSTandCCSandFinished ctx
+    mticket <- usingState_ ctx getTLS12SessionTicket
+    session <- usingState_ ctx getSession
+    let midentity = ticketOrSessionID12 mticket session
+    case midentity of
+        Nothing -> return ()
+        Just identity -> do
+            sessionData <- getSessionData ctx
+            void $
+                sessionEstablish
+                    (sharedSessionManager $ ctxShared ctx)
+                    identity
+                    (fromJust sessionData)
+    finishHandshake12 ctx
+    liftIO $ do
+        minfo <- contextGetInformation ctx
+        case minfo of
+            Nothing -> return ()
+            Just info -> onServerFinished (clientHooks cparams) info
+
+recvNSTandCCSandFinished :: Context -> IO ()
+recvNSTandCCSandFinished ctx = do
+    st <- isJust <$> usingState_ ctx getTLS12SessionTicket
+    if st
+        then runRecvState ctx $ RecvStateHandshake expectNewSessionTicket
+        else do runRecvState ctx $ RecvStatePacket expectChangeCipher
+  where
+    expectNewSessionTicket (NewSessionTicket _ ticket) = do
+        usingState_ ctx $ setTLS12SessionTicket ticket
+        return $ RecvStatePacket expectChangeCipher
+    expectNewSessionTicket p = unexpected (show p) (Just "Handshake Finished")
+
+    expectChangeCipher ChangeCipherSpec = do
+        enableMyRecordLimit ctx
+        return $ RecvStateHandshake $ expectFinished ctx
+    expectChangeCipher p = unexpected (show p) (Just "change cipher")
+
+----------------------------------------------------------------
+
+-- | TLS 1.2 and below.  Send the client handshake messages that
+-- follow the @ServerHello@, etc. except for @CCS@ and @Finished@.
+--
+-- XXX: Is any buffering done here to combined these messages into
+-- a single TCP packet?  Otherwise we're prone to Nagle delays, or
+-- in any case needlessly generate multiple small packets, where
+-- a single larger packet will do.  The TLS 1.3 code path seems
+-- to separating record generation and transmission and sending
+-- multiple records in a single packet.
+--
+--       -> [certificate]
+--       -> client key exchange
+--       -> [cert verify]
+sendClientCCC :: ClientParams -> Context -> IO ()
+sendClientCCC cparams ctx = do
+    sendCertificate cparams ctx
+    sendClientKeyXchg cparams ctx
+    sendCertificateVerify ctx
+
+----------------------------------------------------------------
+
+sendCertificate :: ClientParams -> Context -> IO ()
+sendCertificate cparams ctx = do
+    usingHState ctx $ setClientCertSent False
+    clientChain cparams ctx >>= \case
+        Nothing -> return ()
+        Just cc@(CertificateChain certs) -> do
+            unless (null certs) $
+                usingHState ctx $
+                    setClientCertSent True
+            sendPacket12 ctx $ Handshake [Certificate (CertificateChain_ cc)] []
+
+----------------------------------------------------------------
+
+sendClientKeyXchg :: ClientParams -> Context -> IO ()
+sendClientKeyXchg cparams ctx = do
+    cipher <- usingHState ctx getPendingCipher
+    (ckx, setMainSec) <- case cipherKeyExchange cipher of
+        CipherKeyExchange_RSA -> getCKX_RSA ctx
+        CipherKeyExchange_DHE_RSA -> getCKX_DHE cparams ctx
+        CipherKeyExchange_DHE_DSA -> getCKX_DHE cparams ctx
+        CipherKeyExchange_ECDHE_RSA -> getCKX_ECDHE ctx
+        CipherKeyExchange_ECDHE_ECDSA -> getCKX_ECDHE ctx
+        _ ->
+            throwCore $
+                Error_Protocol "client key exchange unsupported type" HandshakeFailure
+    sendPacket12 ctx $ Handshake [ClientKeyXchg ckx] []
+    mainSecret <- usingHState ctx setMainSec
+    logKey ctx (MainSecret mainSecret)
+
+--------------------------------
+
+getCKX_RSA
+    :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Secret)
+getCKX_RSA ctx = do
+    clientVersion <- usingHState ctx $ gets hstClientVersion
+    (xver, prerand) <- usingState_ ctx $ (,) <$> getVersion <*> genRandom 46
+
+    let preMain = convert $ encodePreMainSecret clientVersion prerand
+        setMainSec = setMainSecretFromPre xver ClientRole preMain
+    encryptedPreMain <- do
+        -- SSL3 implementation generally forget this length field since it's redundant,
+        -- however TLS10 make it clear that the length field need to be present.
+        e <- encryptRSA ctx preMain
+        let extra = encodeWord16 $ fromIntegral $ B.length e
+        return $ extra `B.append` e
+    return (CKX_RSA encryptedPreMain, setMainSec)
+
+--------------------------------
+
+getCKX_DHE
+    :: ClientParams
+    -> Context
+    -> IO (ClientKeyXchgAlgorithmData, HandshakeM Secret)
+getCKX_DHE cparams ctx = do
+    xver <- usingState_ ctx getVersion
+    serverParams <- usingHState ctx getServerDHParams
+
+    let params = serverDHParamsToParams serverParams
+        ffGroup = findFiniteFieldGroup params
+        srvpub = serverDHParamsToPublic serverParams
+
+    unless (maybe False (isSupportedGroup ctx) ffGroup) $ do
+        groupUsage <-
+            onCustomFFDHEGroup (clientHooks cparams) params srvpub
+                `catchException` throwMiscErrorOnException "custom group callback failed"
+        case groupUsage of
+            GroupUsageInsecure ->
+                throwCore $
+                    Error_Protocol "FFDHE group is not secure enough" InsufficientSecurity
+            GroupUsageUnsupported reason ->
+                throwCore $
+                    Error_Protocol ("unsupported FFDHE group: " ++ reason) HandshakeFailure
+            GroupUsageInvalidPublic -> throwCore $ Error_Protocol "invalid server public key" IllegalParameter
+            GroupUsageValid -> return ()
+
+    -- When grp is known but not in the supported list we use it
+    -- anyway.  This provides additional validation and a more
+    -- efficient implementation.
+    (clientDHPub, preMain) <-
+        case ffGroup of
+            Nothing -> do
+                (clientDHPriv, clientDHPub) <- generateDHE ctx params
+                let preMain = dhGetShared params clientDHPriv srvpub
+                return (clientDHPub, preMain)
+            Just grp -> do
+                usingHState ctx $ setSupportedGroup grp
+                dhePair <- generateFFDHEShared ctx grp srvpub
+                case dhePair of
+                    Nothing ->
+                        throwCore $
+                            Error_Protocol ("invalid server " ++ show grp ++ " public key") IllegalParameter
+                    Just pair -> return pair
+
+    let setMainSec = setMainSecretFromPre xver ClientRole preMain
+    return (CKX_DH clientDHPub, setMainSec)
+
+--------------------------------
+
+getCKX_ECDHE
+    :: Context -> IO (ClientKeyXchgAlgorithmData, HandshakeM Secret)
+getCKX_ECDHE ctx = do
+    ServerECDHParams grp srvpub <- usingHState ctx getServerECDHParams
+    checkSupportedGroup ctx grp
+    usingHState ctx $ setSupportedGroup grp
+    ecdhePair <- encapsulateGroup ctx srvpub
+    case ecdhePair of
+        Nothing ->
+            throwCore $
+                Error_Protocol ("invalid server " ++ show grp ++ " public key") IllegalParameter
+        Just (clipub, preMain) -> do
+            xver <- usingState_ ctx getVersion
+            let setMainSec = setMainSecretFromPre xver ClientRole preMain
+            return (CKX_ECDH $ groupEncodePublicB clipub, setMainSec)
+
+----------------------------------------------------------------
+
+-- In order to send a proper certificate verify message,
+-- we have to do the following:
+--
+-- 1. Determine which signing algorithm(s) the server supports
+--    (we currently only support RSA).
+-- 2. Get the current handshake hash from the handshake state.
+-- 3. Sign the handshake hash
+-- 4. Send it to the server.
+--
+sendCertificateVerify :: Context -> IO ()
+sendCertificateVerify ctx = do
+    ver <- usingState_ ctx getVersion
+
+    -- Only send a certificate verify message when we
+    -- have sent a non-empty list of certificates.
+    --
+    certSent <- usingHState ctx getClientCertSent
+    when certSent $ do
+        pubKey <- getLocalPublicKey ctx
+        mhashSig <-
+            let cHashSigs = supportedHashSignatures $ ctxSupported ctx
+             in getLocalHashSigAlg ctx signatureCompatible cHashSigs pubKey
+        -- Fetch all handshake messages up to now.
+        msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
+        sigDig <- createCertificateVerify ctx ver pubKey mhashSig msgs
+        sendPacket12 ctx $ Handshake [CertVerify sigDig] []
diff --git a/Network/TLS/Handshake/Client/TLS13.hs b/Network/TLS/Handshake/Client/TLS13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Client/TLS13.hs
@@ -0,0 +1,425 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.Client.TLS13 (
+    recvServerSecondFlight13,
+    sendClientSecondFlight13,
+    asyncServerHello13,
+    postHandshakeAuthClientWith,
+) where
+
+import Control.Exception (bracket)
+import Control.Monad.State.Strict
+import qualified Data.ByteArray as BA
+import Data.IORef
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import Network.TLS.Error
+import Network.TLS.Extension
+import Network.TLS.Handshake.Client.Common
+import Network.TLS.Handshake.Client.ServerHello
+import Network.TLS.Handshake.Common hiding (expectFinished)
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Control
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+import Network.TLS.X509
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+recvServerSecondFlight13 :: ClientParams -> Context -> [Group] -> IO ()
+recvServerSecondFlight13 cparams ctx groupSent = do
+    resuming <- prepareSecondFlight13 ctx groupSent
+    runRecvHandshake13 $ do
+        recvHandshake13 ctx $ expectEncryptedExtensions ctx
+        unless resuming $ recvHandshake13 ctx $ expectCertRequest cparams ctx
+        recvHandshake13hash ctx "Finished" $ expectFinished cparams ctx
+
+----------------------------------------------------------------
+
+prepareSecondFlight13
+    :: Context -> [Group] -> IO Bool
+prepareSecondFlight13 ctx groupSent = do
+    choice <- makeCipherChoice TLS13 <$> usingHState ctx getPendingCipher
+    prepareSecondFlight13' ctx groupSent choice
+
+prepareSecondFlight13'
+    :: Context
+    -> [Group]
+    -> CipherChoice
+    -> IO Bool
+prepareSecondFlight13' ctx groupSent choice = do
+    (_, hkey, resuming) <- switchToHandshakeSecret
+    let clientHandshakeSecret = triClient hkey
+        serverHandshakeSecret = triServer hkey
+        handSecInfo = HandshakeSecretInfo usedCipher (clientHandshakeSecret, serverHandshakeSecret)
+    contextSync ctx $ RecvServerHello handSecInfo
+    modifyTLS13State ctx $ \st ->
+        st
+            { tls13stChoice = choice
+            , tls13stHsKey = Just hkey
+            }
+    return resuming
+  where
+    usedCipher = cCipher choice
+    usedHash = cHash choice
+
+    hashSize = hashDigestSize usedHash
+
+    switchToHandshakeSecret = do
+        ensureRecvComplete ctx
+        ecdhe <- calcSharedKey
+        (earlySecret, resuming) <- makeEarlySecret
+        handKey <- calculateHandshakeSecret ctx choice earlySecret ecdhe
+        let serverHandshakeSecret = triServer handKey
+        setRxRecordState ctx usedHash usedCipher serverHandshakeSecret
+        return (usedCipher, handKey, resuming)
+
+    calcSharedKey = do
+        serverKeyShare <- do
+            mks <- usingState_ ctx getTLS13KeyShare
+            case mks of
+                Just (KeyShareServerHello ks) -> return ks
+                Just _ ->
+                    throwCore $ Error_Protocol "invalid key_share value" IllegalParameter
+                Nothing ->
+                    throwCore $
+                        Error_Protocol
+                            "key exchange not implemented, expected key_share extension"
+                            HandshakeFailure
+        let grp = keyShareEntryGroup serverKeyShare
+        unless (checkServerKeyShareKeyLength serverKeyShare) $
+            throwCore $
+                Error_Protocol "broken key_share" IllegalParameter
+        unless (grp `elem` groupSent) $
+            throwCore $
+                Error_Protocol "received incompatible group for (EC)DHE" IllegalParameter
+        usingHState ctx $ setSupportedGroup grp
+        usingHState ctx getGroupPrivate >>= fromServerKeyShare serverKeyShare
+
+    makeEarlySecret = do
+        mEarlySecretPSK <- usingHState ctx getTLS13EarlySecret
+        case mEarlySecretPSK of
+            Nothing -> return (initEarlySecret choice Nothing, False)
+            Just earlySecretPSK@(BaseSecret sec) -> do
+                mSelectedIdentity <- usingState_ ctx getTLS13PreSharedKey
+                case mSelectedIdentity of
+                    Nothing ->
+                        return (initEarlySecret choice Nothing, False)
+                    Just (PreSharedKeyServerHello 0) -> do
+                        unless (BA.length sec == hashSize) $
+                            throwCore $
+                                Error_Protocol
+                                    "selected cipher is incompatible with selected PSK"
+                                    IllegalParameter
+                        usingHState ctx $ setTLS13HandshakeMode PreSharedKey
+                        return (earlySecretPSK, True)
+                    Just _ ->
+                        throwCore $ Error_Protocol "selected identity out of range" IllegalParameter
+
+----------------------------------------------------------------
+
+expectEncryptedExtensions
+    :: MonadIO m => Context -> Handshake13 -> m ()
+expectEncryptedExtensions ctx (EncryptedExtensions13 eexts) = do
+    liftIO $ do
+        setALPN ctx MsgTEncryptedExtensions eexts
+        modifyTLS13State ctx $ \st -> st{tls13stClientExtensions = eexts}
+    st13 <- usingHState ctx getTLS13RTT0Status
+    when (st13 == RTT0Sent) $
+        case extensionLookup EID_EarlyData eexts of
+            Just _ -> do
+                usingHState ctx $ setTLS13HandshakeMode RTT0
+                usingHState ctx $ setTLS13RTT0Status RTT0Accepted
+                liftIO $ modifyTLS13State ctx $ \st -> st{tls13st0RTTAccepted = True}
+            Nothing -> do
+                usingHState ctx $ setTLS13HandshakeMode PreSharedKey
+                usingHState ctx $ setTLS13RTT0Status RTT0Rejected
+expectEncryptedExtensions _ h = unexpected (show h) (Just "encrypted extensions")
+
+----------------------------------------------------------------
+-- not used in 0-RTT
+expectCertRequest
+    :: MonadIO m
+    => ClientParams -> Context -> Handshake13 -> RecvHandshake13M m ()
+expectCertRequest cparams ctx (CertRequest13 token exts) = do
+    processCertRequest13 ctx token exts
+    recvHandshake13 ctx $ expectCertAndVerify cparams ctx
+expectCertRequest cparams ctx other = do
+    usingHState ctx $ do
+        setCertReqToken Nothing
+        setCertReqCBdata Nothing
+    -- setCertReqSigAlgsCert Nothing
+    expectCertAndVerify cparams ctx other
+
+processCertRequest13
+    :: MonadIO m => Context -> CertReqContext -> [ExtensionRaw] -> m ()
+processCertRequest13 ctx token exts = do
+    let hsextID = EID_SignatureAlgorithms
+    -- caextID = EID_SignatureAlgorithmsCert
+    dNames <- canames
+    -- The @signature_algorithms@ extension is mandatory.
+    hsAlgs <- extalgs hsextID unsighash
+    cTypes <- case hsAlgs of
+        Just as ->
+            let validAs = filter isHashSignatureValid13 as
+             in return $ sigAlgsToCertTypes ctx validAs
+        Nothing -> throwCore $ Error_Protocol "invalid certificate request" HandshakeFailure
+    -- Unused:
+    -- caAlgs <- extalgs caextID uncertsig
+    let zlib =
+            lookupAndDecode
+                EID_CompressCertificate
+                MsgTClientHello
+                exts
+                False
+                (\(CompressCertificate ccas) -> CCA_Zlib `elem` ccas)
+    usingHState ctx $ do
+        setCertReqToken $ Just token
+        setCertReqCBdata $ Just (cTypes, hsAlgs, dNames)
+        setTLS13CertComp zlib
+  where
+    -- setCertReqSigAlgsCert caAlgs
+
+    canames = case extensionLookup EID_CertificateAuthorities exts of
+        Nothing -> return []
+        Just ext -> case extensionDecode MsgTCertificateRequest ext of
+            Just (CertificateAuthorities names) -> return names
+            _ -> throwCore $ Error_Protocol "invalid certificate request" HandshakeFailure
+    extalgs extID decons = case extensionLookup extID exts of
+        Nothing -> return Nothing
+        Just ext -> case extensionDecode MsgTCertificateRequest ext of
+            Just e ->
+                return $ decons e
+            _ -> throwCore $ Error_Protocol "invalid certificate request" HandshakeFailure
+    unsighash
+        :: SignatureAlgorithms
+        -> Maybe [HashAndSignatureAlgorithm]
+    unsighash (SignatureAlgorithms a) = Just a
+
+----------------------------------------------------------------
+-- not used in 0-RTT
+expectCertAndVerify
+    :: MonadIO m
+    => ClientParams -> Context -> Handshake13 -> RecvHandshake13M m ()
+expectCertAndVerify cparams ctx (Certificate13 _ (CertificateChain_ cc) _) = processCertAndVerify cparams ctx cc
+expectCertAndVerify cparams ctx (CompressedCertificate13 _ (CertificateChain_ cc) _) = processCertAndVerify cparams ctx cc
+expectCertAndVerify _ _ h = unexpected (show h) (Just "server certificate")
+
+processCertAndVerify
+    :: MonadIO m
+    => ClientParams -> Context -> CertificateChain -> RecvHandshake13M m ()
+processCertAndVerify cparams ctx cc = do
+    liftIO $ usingState_ ctx $ setServerCertificateChain cc
+    liftIO $ doCertificate cparams ctx cc
+    let pubkey = certPubKey $ getCertificate $ getCertificateChainLeaf cc
+    ver <- liftIO $ usingState_ ctx getVersion
+    checkDigitalSignatureKey ver pubkey
+    usingHState ctx $ setPublicKey pubkey
+    recvHandshake13hash ctx "CertVerify" $ expectCertVerify ctx pubkey
+
+----------------------------------------------------------------
+
+expectCertVerify
+    :: MonadIO m
+    => Context -> PubKey -> TranscriptHash -> Handshake13 -> m ()
+expectCertVerify ctx pubkey (TranscriptHash hChSc) (CertVerify13 (DigitallySigned sigAlg sig)) = do
+    ok <- checkCertVerify ctx pubkey sigAlg sig hChSc
+    unless ok $ decryptError "cannot verify CertificateVerify"
+expectCertVerify _ _ _ h = unexpected (show h) (Just "certificate verify")
+
+----------------------------------------------------------------
+
+expectFinished
+    :: MonadIO m
+    => ClientParams
+    -> Context
+    -> TranscriptHash
+    -> Handshake13
+    -> m ()
+expectFinished cparams ctx hashValue (Finished13 verifyData) = do
+    st <- liftIO $ getTLS13State ctx
+    let usedHash = cHash $ tls13stChoice st
+        ServerTrafficSecret baseKey = triServer $ fromJust $ tls13stHsKey st
+    checkFinished ctx usedHash baseKey hashValue verifyData
+    liftIO $ do
+        minfo <- contextGetInformation ctx
+        case minfo of
+            Nothing -> return ()
+            Just info -> onServerFinished (clientHooks cparams) info
+    liftIO $ modifyTLS13State ctx $ \s -> s{tls13stRecvSF = True}
+expectFinished _ _ _ p = unexpected (show p) (Just "server finished")
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+sendClientSecondFlight13 :: ClientParams -> Context -> IO ()
+sendClientSecondFlight13 cparams ctx = do
+    st <- getTLS13State ctx
+    let choice = tls13stChoice st
+        hkey = fromJust $ tls13stHsKey st
+        rtt0accepted = tls13st0RTTAccepted st
+        eexts = tls13stClientExtensions st
+    sendClientSecondFlight13' cparams ctx choice hkey rtt0accepted eexts
+    modifyTLS13State ctx $ \s -> s{tls13stSentCF = True}
+    echAccepted <- usingHState ctx getECHAccepted
+    when (clientUseECH cparams && not echAccepted) $
+        throwCore $
+            Error_Protocol "ECH is not accepted" EchRequired
+
+sendClientSecondFlight13'
+    :: ClientParams
+    -> Context
+    -> CipherChoice
+    -> SecretTriple HandshakeSecret
+    -> Bool
+    -> [ExtensionRaw]
+    -> IO ()
+sendClientSecondFlight13' cparams ctx choice hkey rtt0accepted eexts = do
+    hChSf <- transcriptHash ctx "CH..SF"
+    unless (ctxQUICMode ctx) $
+        runPacketFlight ctx $
+            sendChangeCipherSpec13 ctx
+    when (rtt0accepted && not (ctxQUICMode ctx)) $
+        sendPacket13 ctx (Handshake13 [EndOfEarlyData13] [])
+    let clientHandshakeSecret = triClient hkey
+    setTxRecordState ctx usedHash usedCipher clientHandshakeSecret
+    sendClientFlight13 cparams ctx usedHash clientHandshakeSecret
+    appKey <- switchToApplicationSecret hChSf
+    let applicationSecret = triBase appKey
+    setResumptionSecret applicationSecret
+    let appSecInfo = ApplicationSecretInfo (triClient appKey, triServer appKey)
+    contextSync ctx $ SendClientFinished eexts appSecInfo
+    modifyTLS13State ctx $ \st -> st{tls13stHsKey = Nothing}
+    finishHandshake13 ctx
+    rtt0 <- tls13st0RTT <$> getTLS13State ctx
+    when rtt0 $ do
+        builder <- tls13stPendingSentData <$> getTLS13State ctx
+        modifyTLS13State ctx $ \st -> st{tls13stPendingSentData = id}
+        unless rtt0accepted $
+            mapM_ (sendPacket13 ctx . AppData13) $
+                builder []
+  where
+    usedCipher = cCipher choice
+    usedHash = cHash choice
+
+    switchToApplicationSecret hChSf = do
+        ensureRecvComplete ctx
+        let handshakeSecret = triBase hkey
+        appKey <- calculateApplicationSecret ctx choice handshakeSecret hChSf
+        let serverApplicationSecret0 = triServer appKey
+        let clientApplicationSecret0 = triClient appKey
+        setTxRecordState ctx usedHash usedCipher clientApplicationSecret0
+        setRxRecordState ctx usedHash usedCipher serverApplicationSecret0
+        return appKey
+
+    setResumptionSecret applicationSecret = do
+        resumptionSecret <- calculateResumptionSecret ctx choice applicationSecret
+        usingHState ctx $ setTLS13ResumptionSecret resumptionSecret
+
+{- Unused for now
+uncertsig :: SignatureAlgorithmsCert
+          -> Maybe [HashAndSignatureAlgorithm]
+uncertsig (SignatureAlgorithmsCert a) = Just a
+-}
+
+sendClientFlight13
+    :: ClientParams -> Context -> Hash -> ClientTrafficSecret a -> IO ()
+sendClientFlight13 cparams ctx usedHash (ClientTrafficSecret baseKey) = do
+    mcc <- clientChain cparams ctx
+    runPacketFlight ctx $ do
+        case mcc of
+            Nothing -> return ()
+            Just cc -> do
+                reqtoken <- usingHState ctx getCertReqToken
+                certComp <- usingHState ctx getTLS13CertComp
+                loadClientData13 cc reqtoken certComp
+        rawFinished <- makeFinished ctx usedHash baseKey
+        loadPacket13 ctx $ Handshake13 [rawFinished] []
+    when (isJust mcc) $
+        modifyTLS13State ctx $
+            \st -> st{tls13stSentClientCert = True}
+  where
+    loadClientData13 chain (Just token) certComp = do
+        let (CertificateChain certs) = chain
+            certExts = replicate (length certs) []
+            cHashSigs = filter isHashSignatureValid13 $ supportedHashSignatures $ ctxSupported ctx
+        let certtag = if certComp then CompressedCertificate13 else Certificate13
+        loadPacket13 ctx $
+            Handshake13 [certtag token (CertificateChain_ chain) certExts] []
+        case certs of
+            [] -> return ()
+            _ -> do
+                hChSc <- transcriptHash ctx "CH..SC"
+                pubKey <- getLocalPublicKey ctx
+                sigAlg <-
+                    liftIO $ getLocalHashSigAlg ctx signatureCompatible13 cHashSigs pubKey
+                vfy <- makeCertVerify ctx pubKey sigAlg hChSc
+                loadPacket13 ctx $ Handshake13 [vfy] []
+    --
+    loadClientData13 _ _ _ =
+        throwCore $
+            Error_Protocol "missing TLS 1.3 certificate request context token" InternalError
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+postHandshakeAuthClientWith
+    :: ClientParams -> Context -> Handshake13 -> IO ()
+postHandshakeAuthClientWith cparams ctx (CertRequest13 certReqCtx exts) =
+    bracket (saveHState ctx) (restoreHState ctx) $ \_ -> do
+        --        updateTranscriptHash13 ctx h b
+        processCertRequest13 ctx certReqCtx exts
+        (usedHash, _, level, applicationSecretN) <- getTxRecordState ctx
+        unless (level == CryptApplicationSecret) $
+            throwCore $
+                Error_Protocol
+                    "unexpected post-handshake authentication request"
+                    UnexpectedMessage
+        sendClientFlight13
+            cparams
+            ctx
+            usedHash
+            (ClientTrafficSecret applicationSecretN)
+postHandshakeAuthClientWith _ _ _ =
+    throwCore $
+        Error_Protocol
+            "unexpected handshake message received in postHandshakeAuthClientWith"
+            UnexpectedMessage
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+asyncServerHello13
+    :: ClientParams -> Context -> [Group] -> Millisecond -> IO ()
+asyncServerHello13 cparams ctx groupSent chSentTime = do
+    setPendingRecvActions
+        ctx
+        [ PendingRecvActionSelfUpdate True expectServerHello
+        , PendingRecvAction True (expectEncryptedExtensions ctx)
+        , PendingRecvActionHash True expectFinishedAndSet
+        ]
+  where
+    expectServerHello shb@(sh, _) = do
+        setRTT ctx chSentTime
+        processServerHello13 cparams ctx sh
+        updateTranscriptHash13 ctx shb -- update by myself
+        void $ prepareSecondFlight13 ctx groupSent
+    expectFinishedAndSet h sf = do
+        expectFinished cparams ctx h sf
+        liftIO $
+            writeIORef (ctxPendingSendAction ctx) $
+                Just $
+                    sendClientSecondFlight13 cparams
diff --git a/Network/TLS/Handshake/Common.hs b/Network/TLS/Handshake/Common.hs
--- a/Network/TLS/Handshake/Common.hs
+++ b/Network/TLS/Handshake/Common.hs
@@ -1,127 +1,442 @@
-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
-module Network.TLS.Handshake.Common
-    ( handshakeFailed
-    , errorToAlert
-    , unexpected
-    , newSession
-    , handshakeTerminate
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.Common (
+    handshakeFailed,
+    handleException,
+    unexpected,
+    newSession,
+    ensureNullCompression,
+    ticketOrSessionID12,
+
     -- * sending packets
-    , sendChangeCipherAndFinish
+    sendCCSandFinished,
+
     -- * receiving packets
-    , recvChangeCipherAndFinish
-    , RecvState(..)
-    , runRecvState
-    , recvPacketHandshake
-    , onRecvStateHandshake
-    ) where
+    RecvState (..),
+    runRecvState,
+    runRecvStateHS,
+    recvPacketHandshake,
+    onRecvStateHandshake,
+    ensureRecvComplete,
+    processExtendedMainSecret,
+    getSessionData,
+    storePrivInfo,
+    isSupportedGroup,
+    checkSupportedGroup,
+    errorToAlert,
+    errorToAlertMessage,
+    expectFinished,
+    processCertificate,
+    --
+    setPeerRecordSizeLimit,
+    generateFinished,
+    encodeUpdateTranscriptHash12,
+    updateTranscriptHash12,
+    --
+    startHandshake,
+    finishHandshake12,
+    setServerHelloParameters12,
+) where
 
 import Control.Concurrent.MVar
+import Control.Exception (IOException, fromException, handle, throwIO)
+import Control.Monad.State.Strict
+import Data.ByteArray (convert)
+import qualified Data.ByteString as B
 
-import Network.TLS.Parameters
+import Network.TLS.Cipher
+import Network.TLS.Compression
 import Network.TLS.Context.Internal
-import Network.TLS.Session
-import Network.TLS.Struct
-import Network.TLS.IO
-import Network.TLS.State hiding (getNegotiatedProtocol)
-import Network.TLS.Handshake.Process
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Signature
 import Network.TLS.Handshake.State
-import Network.TLS.Record.State
+import Network.TLS.Handshake.State13
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.IO
+import Network.TLS.IO.Encode
+import Network.TLS.Imports
 import Network.TLS.Measurement
+import Network.TLS.Packet
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
 import Network.TLS.Types
-import Network.TLS.Cipher
 import Network.TLS.Util
-import Data.ByteString.Char8 ()
-
-import Control.Monad.State
-import Control.Exception (throwIO)
+import Network.TLS.X509
 
 handshakeFailed :: TLSError -> IO ()
 handshakeFailed err = throwIO $ HandshakeFailed err
 
-errorToAlert :: TLSError -> Packet
-errorToAlert (Error_Protocol (_, _, ad)) = Alert [(AlertLevel_Fatal, ad)]
-errorToAlert _                           = Alert [(AlertLevel_Fatal, InternalError)]
+handleException :: Context -> IO () -> IO ()
+handleException ctx f = catchException f $ \exception -> do
+    debugError (ctxDebug ctx) $ show exception
+    -- If the error was an Uncontextualized TLSException, we replace the
+    -- context with HandshakeFailed. If it's anything else, we convert
+    -- it to a string and wrap it with Error_Misc and HandshakeFailed.
+    let tlserror = case fromException exception of
+            Just e | Uncontextualized e' <- e -> e'
+            _ -> Error_Misc (show exception)
+    established <- ctxEstablished ctx
+    setEstablished ctx NotEstablished
+    handle ignoreIOErr $ do
+        tls13 <- tls13orLater ctx
+        if tls13
+            then do
+                when (established == EarlyDataSending) $ clearTxRecordState ctx
+                when (tlserror /= Error_TCP_Terminate) $
+                    sendPacket13 ctx $
+                        Alert13 [errorToAlert tlserror]
+            else sendPacket12 ctx $ Alert [errorToAlert tlserror]
+    handshakeFailed tlserror
+  where
+    ignoreIOErr :: IOException -> IO ()
+    ignoreIOErr _ = return ()
 
-unexpected :: String -> Maybe [Char] -> IO a
-unexpected msg expected = throwCore $ Error_Packet_unexpected msg (maybe "" (" expected: " ++) expected)
+errorToAlert :: TLSError -> (AlertLevel, AlertDescription)
+errorToAlert (Error_Protocol _ ad) = (AlertLevel_Fatal, ad)
+errorToAlert (Error_Protocol_Warning _ ad) = (AlertLevel_Warning, ad)
+errorToAlert (Error_Packet_unexpected _ _) = (AlertLevel_Fatal, UnexpectedMessage)
+errorToAlert (Error_Packet_Parsing msg)
+    | "invalid version" `isInfixOf` msg = (AlertLevel_Fatal, ProtocolVersion)
+    | "request_update" `isInfixOf` msg = (AlertLevel_Fatal, IllegalParameter)
+    | otherwise = (AlertLevel_Fatal, DecodeError)
+errorToAlert _ = (AlertLevel_Fatal, InternalError)
 
-newSession :: Context -> IO Session
-newSession ctx
-    | supportedSession $ ctxSupported ctx = getStateRNG ctx 32 >>= return . Session . Just
-    | otherwise                           = return $ Session Nothing
+-- | Return the message that a TLS endpoint can add to its local log for the
+-- specified library error.
+errorToAlertMessage :: TLSError -> String
+errorToAlertMessage (Error_Protocol msg _) = msg
+errorToAlertMessage (Error_Protocol_Warning msg _) = msg
+errorToAlertMessage (Error_Packet_unexpected msg _) = msg
+errorToAlertMessage (Error_Packet_Parsing msg) = msg
+errorToAlertMessage e = show e
 
--- | when a new handshake is done, wrap up & clean up.
-handshakeTerminate :: Context -> IO ()
-handshakeTerminate ctx = do
-    session <- usingState_ ctx getSession
-    -- only callback the session established if we have a session
-    case session of
-        Session (Just sessionId) -> do
-            sessionData <- getSessionData ctx
-            liftIO $ sessionEstablish (sharedSessionManager $ ctxShared ctx) sessionId (fromJust "session-data" sessionData)
-        _ -> return ()
-    -- forget all handshake data now and reset bytes counters.
-    liftIO $ modifyMVar_ (ctxHandshake ctx) (return . const Nothing)
-    updateMeasure ctx resetBytesCounters
-    -- mark the secure connection up and running.
-    setEstablished ctx True
-    return ()
+unexpected :: MonadIO m => String -> Maybe String -> m a
+unexpected msg expected =
+    throwCore $ Error_Packet_unexpected msg (maybe "" (" expected: " ++) expected)
 
-sendChangeCipherAndFinish :: IO ()   -- ^ message possibly sent between ChangeCipherSpec and Finished.
-                          -> Context
-                          -> Role
-                          -> IO ()
-sendChangeCipherAndFinish betweenCall ctx role = do
-    sendPacket ctx ChangeCipherSpec
-    betweenCall
-    liftIO $ contextFlush ctx
-    cf <- usingState_ ctx getVersion >>= \ver -> usingHState ctx $ getHandshakeDigest ver role
-    sendPacket ctx (Handshake [Finished cf])
-    liftIO $ contextFlush ctx
+newSession :: Context -> IO Session
+newSession ctx
+    | supportedSession $ ctxSupported ctx = Session . Just <$> getStateRNG ctx 32
+    | otherwise = return $ Session Nothing
 
-recvChangeCipherAndFinish :: Context -> IO ()
-recvChangeCipherAndFinish ctx = runRecvState ctx (RecvStateNext expectChangeCipher)
-  where expectChangeCipher ChangeCipherSpec = return $ RecvStateHandshake expectFinish
-        expectChangeCipher p                = unexpected (show p) (Just "change cipher")
-        expectFinish (Finished _) = return RecvStateDone
-        expectFinish p            = unexpected (show p) (Just "Handshake Finished")
+sendCCSandFinished
+    :: Context
+    -> Role
+    -> IO ()
+sendCCSandFinished ctx role = do
+    sendPacket12 ctx ChangeCipherSpec
+    contextFlush ctx
+    enablePeerRecordLimit ctx
+    ver <- usingState_ ctx getVersion
+    verifyData <- VerifyData <$> generateFinished ctx ver role
+    sendPacket12 ctx (Handshake [Finished verifyData] [])
+    usingState_ ctx $ setVerifyDataForSend verifyData
+    contextFlush ctx
 
-data RecvState m =
-      RecvStateNext (Packet -> m (RecvState m))
+data RecvState m
+    = RecvStatePacket (Packet -> m (RecvState m)) -- CCS is not Handshake
     | RecvStateHandshake (Handshake -> m (RecvState m))
     | RecvStateDone
 
-recvPacketHandshake :: Context -> IO [Handshake]
+recvPacketHandshake :: Context -> IO [HandshakeR]
 recvPacketHandshake ctx = do
-    pkts <- recvPacket ctx
+    pkts <- recvPacket12 ctx
     case pkts of
-        Right (Handshake l) -> return l
-        Right x             -> fail ("unexpected type received. expecting handshake and got: " ++ show x)
-        Left err            -> throwCore err
+        Right (Handshake hss bss) -> return $ zip hss bss
+        Right x@(AppData _) -> do
+            -- If a TLS13 server decides to reject RTT0 data, the server should
+            -- skip records for RTT0 data up to the maximum limit.
+            established <- ctxEstablished ctx
+            case established of
+                EarlyDataNotAllowed n
+                    | n > 0 -> do
+                        setEstablished ctx $ EarlyDataNotAllowed (n - 1)
+                        recvPacketHandshake ctx
+                _ -> unexpected (show x) (Just "handshake")
+        Right x -> unexpected (show x) (Just "handshake")
+        Left err -> throwCore err
 
 -- | process a list of handshakes message in the recv state machine.
-onRecvStateHandshake :: Context -> RecvState IO -> [Handshake] -> IO (RecvState IO)
-onRecvStateHandshake _   recvState [] = return recvState
-onRecvStateHandshake ctx (RecvStateHandshake f) (x:xs) = do
-    nstate <- f x
-    processHandshake ctx x
-    onRecvStateHandshake ctx nstate xs
-onRecvStateHandshake _ _ _   = unexpected "spurious handshake" Nothing
+onRecvStateHandshake
+    :: Context -> RecvState IO -> [HandshakeR] -> IO (RecvState IO)
+onRecvStateHandshake _ recvState [] = return recvState
+onRecvStateHandshake _ (RecvStatePacket f) hbs = do
+    let (hss, bss) = unzip hbs
+    f (Handshake hss bss)
+onRecvStateHandshake ctx (RecvStateHandshake f) (hb@(h, _) : hbs) = do
+    let finished = isFinished h
+    unless finished $ void $ updateTranscriptHash12 ctx hb
+    nstate <- f h
+    when finished $ void $ updateTranscriptHash12 ctx hb
+    onRecvStateHandshake ctx nstate hbs
+onRecvStateHandshake _ _ _ = unexpected "spurious handshake" Nothing
 
+isFinished :: Handshake -> Bool
+isFinished Finished{} = True
+isFinished _ = False
+
 runRecvState :: Context -> RecvState IO -> IO ()
-runRecvState _   (RecvStateDone)   = return ()
-runRecvState ctx (RecvStateNext f) = recvPacket ctx >>= either throwCore f >>= runRecvState ctx
-runRecvState ctx iniState          = recvPacketHandshake ctx >>= onRecvStateHandshake ctx iniState >>= runRecvState ctx
+runRecvState _ RecvStateDone = return ()
+runRecvState ctx (RecvStatePacket f) = recvPacket12 ctx >>= either throwCore f >>= runRecvState ctx
+runRecvState ctx iniState =
+    recvPacketHandshake ctx
+        >>= onRecvStateHandshake ctx iniState
+        >>= runRecvState ctx
 
+runRecvStateHS
+    :: Context -> RecvState IO -> [HandshakeR] -> IO ()
+runRecvStateHS ctx iniState hbs = onRecvStateHandshake ctx iniState hbs >>= runRecvState ctx
+
+ensureRecvComplete :: MonadIO m => Context -> m ()
+ensureRecvComplete ctx = do
+    complete <- liftIO $ isRecvComplete ctx
+    unless complete $
+        throwCore $
+            Error_Protocol "received incomplete message at key change" UnexpectedMessage
+
+processExtendedMainSecret
+    :: MonadIO m => Context -> Version -> MessageType -> [ExtensionRaw] -> m Bool
+processExtendedMainSecret ctx ver msgt exts
+    | ver < TLS10 = return False
+    | ver > TLS12 = error "EMS processing is not compatible with TLS 1.3"
+    | ems == NoEMS = return False
+    | otherwise =
+        liftIO $
+            lookupAndDecodeAndDo
+                EID_ExtendedMainSecret
+                msgt
+                exts
+                nonExistAction
+                existAction
+  where
+    ems = supportedExtendedMainSecret $ ctxSupported ctx
+    err = "peer does not support Extended Main Secret"
+    nonExistAction =
+        if ems == RequireEMS
+            then throwCore $ Error_Protocol err HandshakeFailure
+            else return False
+    existAction ExtendedMainSecret = do
+        usingHState ctx $ setExtendedMainSecret True
+        return True
+
 getSessionData :: Context -> IO (Maybe SessionData)
 getSessionData ctx = do
     ver <- usingState_ ctx getVersion
-    mms <- usingHState ctx (gets hstMasterSecret)
-    tx  <- liftIO $ readMVar (ctxTxState ctx)
+    sni <- usingState_ ctx getClientSNI
+    mms <- usingHState ctx $ gets hstMainSecret
+    ems <- usingHState ctx getExtendedMainSecret
+    cipher <- cipherID <$> usingHState ctx getPendingCipher
+    alpn <- usingState_ ctx getNegotiatedProtocol
+    let compression = 0
+        flags = [SessionEMS | ems]
     case mms of
         Nothing -> return Nothing
-        Just ms -> return $ Just $ SessionData
+        Just ms ->
+            return $
+                Just
+                    SessionData
                         { sessionVersion = ver
-                        , sessionCipher  = cipherID $ fromJust "cipher" $ stCipher tx
-                        , sessionSecret  = ms
+                        , sessionCipher = cipher
+                        , sessionCompression = compression
+                        , sessionClientSNI = sni
+                        , sessionSecret = convert ms
+                        , sessionGroup = Nothing
+                        , sessionTicketInfo = Nothing
+                        , sessionALPN = alpn
+                        , sessionMaxEarlyDataSize = 0
+                        , sessionFlags = flags
                         }
+
+-- | Store the specified keypair.  Whether the public key and private key
+-- actually match is left for the peer to discover.  We're not presently
+-- burning  CPU to detect that misconfiguration.  We verify only that the
+-- types of keys match and that it does not include an algorithm that would
+-- not be safe.
+storePrivInfo
+    :: MonadIO m
+    => Context
+    -> CertificateChain
+    -> PrivKey
+    -> m PubKey
+storePrivInfo ctx cc privkey = do
+    let c = fromCC cc
+        pubkey = certPubKey $ getCertificate c
+    unless (isDigitalSignaturePair (pubkey, privkey)) $
+        throwCore $
+            Error_Protocol "mismatched or unsupported private key pair" InternalError
+    usingHState ctx $ setPublicPrivateKeys (pubkey, privkey)
+    return pubkey
+  where
+    fromCC (CertificateChain (c : _)) = c
+    fromCC _ = error "fromCC"
+
+-- verify that the group selected by the peer is supported in the local
+-- configuration
+checkSupportedGroup :: Context -> Group -> IO ()
+checkSupportedGroup ctx grp =
+    unless (isSupportedGroup ctx grp) $
+        let msg = "unsupported (EC)DHE group: " ++ show grp
+         in throwCore $ Error_Protocol msg IllegalParameter
+
+isSupportedGroup :: Context -> Group -> Bool
+isSupportedGroup ctx grp = grp `elem` supportedGroups (ctxSupported ctx)
+
+ensureNullCompression :: MonadIO m => CompressionID -> m ()
+ensureNullCompression compression =
+    when (compression /= compressionID nullCompression) $
+        throwCore $
+            Error_Protocol "compression is not allowed in TLS 1.3" IllegalParameter
+
+expectFinished :: Context -> Handshake -> IO (RecvState IO)
+expectFinished ctx (Finished verifyData) = do
+    processFinished ctx verifyData
+    return RecvStateDone
+expectFinished _ p = unexpected (show p) (Just "Handshake Finished")
+
+processFinished :: Context -> VerifyData -> IO ()
+processFinished ctx verifyData = do
+    (cc, ver) <- usingState_ ctx $ (,) <$> getRole <*> getVersion
+    expected <- VerifyData <$> generateFinished ctx ver (invertRole cc)
+    when (expected /= verifyData) $ decryptError "finished verification failed"
+    usingState_ ctx $ setVerifyDataForRecv verifyData
+
+processCertificate :: Context -> Role -> CertificateChain -> IO ()
+processCertificate _ ServerRole (CertificateChain []) = return ()
+processCertificate _ ClientRole (CertificateChain []) =
+    throwCore $ Error_Protocol "server certificate missing" HandshakeFailure
+processCertificate ctx _ (CertificateChain (c : _)) =
+    usingHState ctx $ setPublicKey pubkey
+  where
+    pubkey = certPubKey $ getCertificate c
+
+-- TLS 1.2 distinguishes session ID and session ticket.  session
+-- ticket. Session ticket is prioritized over session ID.
+ticketOrSessionID12
+    :: Maybe Ticket -> Session -> Maybe SessionIDorTicket
+ticketOrSessionID12 (Just ticket) _
+    | ticket /= "" = Just $ B.copy ticket
+ticketOrSessionID12 _ (Session (Just sessionId)) = Just $ B.copy sessionId
+ticketOrSessionID12 _ _ = Nothing
+
+setPeerRecordSizeLimit :: Context -> Bool -> RecordSizeLimit -> IO ()
+setPeerRecordSizeLimit ctx tls13 (RecordSizeLimit n0) = do
+    when (n0 < 64) $
+        throwCore $
+            Error_Protocol ("too small recode size limit: " ++ show n0) IllegalParameter
+
+    -- RFC 8449 Section 4:
+    -- Even if a larger record size limit is provided by a peer, an
+    -- endpoint MUST NOT send records larger than the protocol-defined
+    -- limit, unless explicitly allowed by a future TLS version or
+    -- extension.
+    let n1 = fromIntegral n0
+        n2
+            | n1 > protolim = protolim
+            | otherwise = n1
+    -- Even if peer's value is larger than the protocol-defined
+    -- limitation, call "setPeerRecordLimit" to send
+    -- "record_size_limit" as ACK.  In this case, the protocol-defined
+    -- limitation is used.
+    let lim = if tls13 then n2 - 1 else n2
+    setPeerRecordLimit ctx $ Just lim
+  where
+    protolim
+        | tls13 = defaultRecordSizeLimit + 1
+        | otherwise = defaultRecordSizeLimit
+
+----------------------------------------------------------------
+
+generateFinished :: Context -> Version -> Role -> IO ByteString
+generateFinished ctx ver role = do
+    thash <- transcriptHash ctx "generateFinished"
+    (mainSecret, cipher) <- usingHState ctx $ gets $ \hst ->
+        (fromJust $ hstMainSecret hst, fromJust $ hstPendingCipher hst)
+    return $
+        if role == ClientRole
+            then
+                generateClientFinished ver cipher mainSecret thash
+            else
+                generateServerFinished ver cipher mainSecret thash
+
+generateFinished'
+    :: PRF -> ByteString -> Secret -> TranscriptHash -> ByteString
+generateFinished' prf label mainSecret (TranscriptHash thash) = convert $ prf mainSecret seed 12
+  where
+    seed = label <> thash
+
+generateClientFinished
+    :: Version
+    -> Cipher
+    -> Secret
+    -> TranscriptHash
+    -> ByteString
+generateClientFinished ver ciph =
+    generateFinished' (getPRF ver ciph) "client finished"
+
+generateServerFinished
+    :: Version
+    -> Cipher
+    -> Secret
+    -> TranscriptHash
+    -> ByteString
+generateServerFinished ver ciph =
+    generateFinished' (getPRF ver ciph) "server finished"
+
+----------------------------------------------------------------
+
+-- initialize a new Handshake context (initial handshake or renegotiations)
+startHandshake :: Context -> Version -> ClientRandom -> IO ()
+startHandshake ctx ver crand =
+    void $ swapMVar (ctxHandshakeState ctx) $ Just hs
+  where
+    hs = newEmptyHandshake ver crand
+
+setServerHelloParameters12
+    :: Context
+    -> Version
+    -- ^ chosen version
+    -> ServerRandom
+    -> Cipher
+    -> Compression
+    -> IO ()
+setServerHelloParameters12 ctx ver sran cipher compression = do
+    usingHState ctx $
+        modify' $ \hst ->
+            hst
+                { hstServerRandom = Just sran
+                , hstPendingCipher = Just cipher
+                , hstPendingCompression = compression
+                }
+    transitTranscriptHash ctx "transit" (getHash ver cipher) False
+
+-- The TLS12 Hash is cipher specific, and some TLS12 algorithms use SHA384
+-- instead of the default SHA256.
+getHash :: Version -> Cipher -> Hash
+getHash ver ciph
+    | ver < TLS12 = SHA1_MD5
+    | maybe True (< TLS12) (cipherMinVer ciph) = SHA256
+    | otherwise = cipherHash ciph
+
+-- | when a new handshake is done, wrap up & clean up.
+finishHandshake12 :: Context -> IO ()
+finishHandshake12 ctx = do
+    -- forget most handshake data and reset bytes counters.
+    modifyMVar_ (ctxHandshakeState ctx) $ \case
+        Nothing -> return Nothing
+        Just hshake ->
+            return $
+                Just
+                    (newEmptyHandshake (hstClientVersion hshake) (hstClientRandom hshake))
+                        { hstServerRandom = hstServerRandom hshake
+                        , hstMainSecret = hstMainSecret hshake
+                        , hstExtendedMainSecret = hstExtendedMainSecret hshake
+                        , hstSupportedGroup = hstSupportedGroup hshake
+                        }
+    updateMeasure ctx resetBytesCounters
+    -- mark the secure connection up and running.
+    setEstablished ctx Established
diff --git a/Network/TLS/Handshake/Common13.hs b/Network/TLS/Handshake/Common13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Common13.hs
@@ -0,0 +1,693 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Common13 (
+    makeFinished,
+    checkFinished,
+    makeServerKeyShare,
+    makeClientKeyShare,
+    fromServerKeyShare,
+    makeCertVerify,
+    checkCertVerify,
+    makePSKBinder,
+    replacePSKBinder,
+    sendChangeCipherSpec13,
+    makeCertRequest,
+    createTLS13TicketInfo,
+    ageToObfuscatedAge,
+    isAgeValid,
+    getAge,
+    checkFreshness,
+    getCurrentTimeFromBase,
+    getSessionData13,
+    isHashSignatureValid13,
+    safeNonNegative32,
+    RecvHandshake13M,
+    runRecvHandshake13,
+    recvHandshake13,
+    recvHandshake13hash,
+    CipherChoice (..),
+    makeCipherChoice,
+    initEarlySecret,
+    calculateEarlySecret,
+    calculateHandshakeSecret,
+    calculateApplicationSecret,
+    calculateResumptionSecret,
+    derivePSK,
+    checkClientKeyShareKeyLength,
+    checkServerKeyShareKeyLength,
+    setRTT,
+    computeConfirm,
+    updateTranscriptHash13,
+    setServerHelloParameters13,
+    finishHandshake13,
+) where
+
+import Control.Concurrent.MVar
+import Control.Monad.State.Strict
+import Data.ByteArray (convert)
+import qualified Data.ByteString as B
+import Data.UnixTime
+import Foreign.C.Types (CTime (..))
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import qualified Network.TLS.Crypto.IES as IES
+
+import Network.TLS.Compression
+import Network.TLS.Extension
+import Network.TLS.Handshake.Certificate (extractCAname)
+import Network.TLS.Handshake.Common (unexpected)
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.IO
+import Network.TLS.IO.Encode
+import Network.TLS.Imports
+import Network.TLS.KeySchedule
+import Network.TLS.MAC
+import Network.TLS.Packet13
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+import Network.TLS.Wire
+
+----------------------------------------------------------------
+
+makeFinished :: MonadIO m => Context -> Hash -> Secret -> m Handshake13
+makeFinished ctx usedHash baseKey = do
+    verifyData <-
+        VerifyData . makeVerifyData usedHash baseKey
+            <$> transcriptHash ctx "makeFinished"
+    liftIO $ usingState_ ctx $ setVerifyDataForSend verifyData
+    pure $ Finished13 verifyData
+
+checkFinished
+    :: MonadIO m
+    => Context -> Hash -> Secret -> TranscriptHash -> VerifyData -> m ()
+checkFinished ctx usedHash baseKey (TranscriptHash hashValue) vd@(VerifyData verifyData) = do
+    let verifyData' = makeVerifyData usedHash baseKey $ TranscriptHash hashValue
+    when (B.length verifyData /= B.length verifyData') $
+        throwCore $
+            Error_Protocol "broken Finished" DecodeError
+    unless (verifyData' == verifyData) $ decryptError "finished verification failed"
+    liftIO $ usingState_ ctx $ setVerifyDataForRecv vd
+
+makeVerifyData :: Hash -> Secret -> TranscriptHash -> ByteString
+makeVerifyData usedHash baseKey (TranscriptHash th) =
+    hmac usedHash finishedKey th
+  where
+    hashSize = hashDigestSize usedHash
+    finishedKey = hkdfExpandLabel usedHash baseKey "finished" "" hashSize
+
+----------------------------------------------------------------
+
+makeClientKeyShare
+    :: Context -> Group -> IO ((Group, IES.GroupPrivate), KeyShareEntry)
+makeClientKeyShare ctx grp = do
+    (cpri, cpub) <- generateGroup ctx grp
+    let wcpub = IES.groupEncodePublicA cpub
+        clientKeyShare = KeyShareEntry grp wcpub
+    return ((grp, cpri), clientKeyShare)
+
+makeServerKeyShare :: Context -> KeyShareEntry -> IO (Secret, KeyShareEntry)
+makeServerKeyShare ctx (KeyShareEntry grp wcpub) = case ecpub of
+    Left e -> throwCore $ Error_Protocol (show e) IllegalParameter
+    Right cpub -> do
+        ecdhePair <- encapsulateGroup ctx cpub
+        case ecdhePair of
+            Nothing -> throwCore $ Error_Protocol msgInvalidPublic IllegalParameter
+            Just (spub, share) ->
+                let wspub = IES.groupEncodePublicB spub
+                    serverKeyShare = KeyShareEntry grp wspub
+                 in return (share, serverKeyShare)
+  where
+    ecpub = IES.groupDecodePublicA grp wcpub
+    msgInvalidPublic = "invalid client " ++ show grp ++ " public key"
+
+fromServerKeyShare
+    :: KeyShareEntry -> [(Group, IES.GroupPrivate)] -> IO Secret
+fromServerKeyShare (KeyShareEntry grp wspub) grpCpris = case espub of
+    Left e -> throwCore $ Error_Protocol (show e) IllegalParameter
+    Right spub -> case lookup grp grpCpris of
+        Nothing -> throwCore err
+        Just cpri -> case IES.groupDecapsulate spub cpri of
+            Just shared -> return shared
+            Nothing -> throwCore err
+  where
+    err = Error_Protocol "cannot generate a shared secret on (EC)DH" IllegalParameter
+    espub = IES.groupDecodePublicB grp wspub
+
+----------------------------------------------------------------
+
+serverContextString :: ByteString
+serverContextString = "TLS 1.3, server CertificateVerify"
+
+clientContextString :: ByteString
+clientContextString = "TLS 1.3, client CertificateVerify"
+
+makeCertVerify
+    :: MonadIO m
+    => Context
+    -> PubKey
+    -> HashAndSignatureAlgorithm
+    -> TranscriptHash
+    -> m Handshake13
+makeCertVerify ctx pub hs (TranscriptHash hashValue) = do
+    role <- liftIO $ usingState_ ctx getRole
+    let ctxStr
+            | role == ClientRole = clientContextString
+            | otherwise = serverContextString
+        target = makeTarget ctxStr hashValue
+    CertVerify13 . DigitallySigned hs <$> sign ctx pub hs target
+
+checkCertVerify
+    :: MonadIO m
+    => Context
+    -> PubKey
+    -> HashAndSignatureAlgorithm
+    -> Signature
+    -> ByteString
+    -> m Bool
+checkCertVerify ctx pub hs signature hashValue
+    | pub `signatureCompatible13` hs = liftIO $ do
+        role <- usingState_ ctx getRole
+        let ctxStr
+                | role == ClientRole = serverContextString -- opposite context
+                | otherwise = clientContextString
+            target = makeTarget ctxStr hashValue
+            sigParams = signatureParams pub hs
+        checkHashSignatureValid13 hs
+        checkSupportedHashSignature ctx hs
+        verifyPublic ctx sigParams target signature
+    | otherwise = return False
+
+makeTarget :: ByteString -> ByteString -> ByteString
+makeTarget contextString hashValue = runPut $ do
+    putBytes $ B.replicate 64 32
+    putBytes contextString
+    putWord8 0
+    putBytes hashValue
+
+sign
+    :: MonadIO m
+    => Context
+    -> PubKey
+    -> HashAndSignatureAlgorithm
+    -> ByteString
+    -> m Signature
+sign ctx pub hs target = liftIO $ do
+    role <- usingState_ ctx getRole
+    let sigParams = signatureParams pub hs
+    signPrivate ctx role sigParams target
+
+----------------------------------------------------------------
+
+makePSKBinder
+    :: BaseSecret EarlySecret
+    -> Hash
+    -> Int
+    -> ByteString
+    -- ^ Encoded client hello
+    -> ByteString
+makePSKBinder (BaseSecret sec) usedHash truncLen ech =
+    makeVerifyData usedHash binderKey hChTruncated
+  where
+    hChTruncated = TranscriptHash $ hash usedHash $ trunc ech
+    th = TranscriptHash $ hash usedHash ""
+    binderKey = deriveSecret usedHash sec "res binder" th
+    trunc x = B.take takeLen x
+      where
+        totalLen = B.length x
+        takeLen = totalLen - truncLen
+
+replacePSKBinder :: ByteString -> [ByteString] -> ByteString
+replacePSKBinder pskz bds = tLidentities <> binders
+  where
+    tLidentities = B.take (B.length pskz - B.length binders) pskz
+    -- See instance Extension PreSharedKey
+    binders = runPut $ putOpaque16 $ runPut (mapM_ putBinder bds)
+    putBinder = putOpaque8
+
+----------------------------------------------------------------
+
+sendChangeCipherSpec13 :: Monoid b => Context -> PacketFlightM b ()
+sendChangeCipherSpec13 ctx = do
+    sent <- usingHState ctx $ do
+        b <- getCCS13Sent
+        unless b $ setCCS13Sent True
+        return b
+    unless sent $ loadPacket13 ctx ChangeCipherSpec13
+
+----------------------------------------------------------------
+
+makeCertRequest
+    :: ServerParams -> Context -> CertReqContext -> Bool -> Handshake13
+makeCertRequest sparams ctx certReqCtx zlib =
+    let sigAlgs = SignatureAlgorithms $ supportedHashSignatures $ ctxSupported ctx
+        signatureAlgExt = Just $ toExtensionRaw sigAlgs
+
+        compCertExt
+            | zlib = Just $ toExtensionRaw $ CompressCertificate [CCA_Zlib]
+            | otherwise = Nothing
+
+        caDns = map extractCAname $ serverCACertificates sparams
+        caExt
+            | null caDns = Nothing
+            | otherwise = Just $ toExtensionRaw $ CertificateAuthorities caDns
+
+        crexts =
+            catMaybes
+                [ {- 0x0d -} signatureAlgExt
+                , {- 0x1b -} compCertExt
+                , {- 0x2f -} caExt
+                ]
+     in CertRequest13 certReqCtx crexts
+
+----------------------------------------------------------------
+
+createTLS13TicketInfo
+    :: Second -> Either Context Second -> Maybe Millisecond -> IO TLS13TicketInfo
+createTLS13TicketInfo life ecw mrtt = do
+    -- Left:  serverSendTime
+    -- Right: clientReceiveTime
+    bTime <- getCurrentTimeFromBase
+    add <- case ecw of
+        Left ctx -> B.foldl' (*+) 0 <$> getStateRNG ctx 4
+        Right ad -> return ad
+    return $
+        TLS13TicketInfo
+            { lifetime = life
+            , ageAdd = add
+            , txrxTime = bTime
+            , estimatedRTT = mrtt
+            }
+  where
+    x *+ y = x * 256 + fromIntegral y
+
+ageToObfuscatedAge :: Second -> TLS13TicketInfo -> Second
+ageToObfuscatedAge age TLS13TicketInfo{..} = obfage
+  where
+    obfage = age + ageAdd
+
+obfuscatedAgeToAge :: Second -> TLS13TicketInfo -> Second
+obfuscatedAgeToAge obfage TLS13TicketInfo{..} = age
+  where
+    age = obfage - ageAdd
+
+isAgeValid :: Second -> TLS13TicketInfo -> Bool
+isAgeValid age TLS13TicketInfo{..} = age <= lifetime * 1000
+
+getAge :: TLS13TicketInfo -> IO Second
+getAge TLS13TicketInfo{..} = do
+    let clientReceiveTime = txrxTime
+    clientSendTime <- getCurrentTimeFromBase
+    return $ fromIntegral (clientSendTime - clientReceiveTime) -- milliseconds
+
+checkFreshness :: TLS13TicketInfo -> Second -> IO Bool
+checkFreshness tinfo@TLS13TicketInfo{..} obfAge = do
+    serverReceiveTime <- getCurrentTimeFromBase
+    let freshness =
+            if expectedArrivalTime > serverReceiveTime
+                then expectedArrivalTime - serverReceiveTime
+                else serverReceiveTime - expectedArrivalTime
+    -- Some implementations round age up to second.
+    -- We take max of 2000 and rtt in the case where rtt is too small.
+    let tolerance = max 2000 rtt
+        isFresh = freshness < tolerance
+    return $ isAlive && isFresh
+  where
+    serverSendTime = txrxTime
+    rtt = fromJust estimatedRTT
+    age = obfuscatedAgeToAge obfAge tinfo
+    expectedArrivalTime = serverSendTime + rtt + fromIntegral age
+    isAlive = isAgeValid age tinfo
+
+getCurrentTimeFromBase :: IO Millisecond
+getCurrentTimeFromBase = millisecondsFromBase <$> getUnixTime
+
+millisecondsFromBase :: UnixTime -> Millisecond
+millisecondsFromBase (UnixTime (CTime s) us) =
+    fromIntegral ((s - base) * 1000) + fromIntegral (us `div` 1000)
+  where
+    base = 1483228800
+
+-- UnixTime (CTime base) _= parseUnixTimeGMT webDateFormat "Sun, 01 Jan 2017 00:00:00 GMT"
+
+----------------------------------------------------------------
+
+getSessionData13
+    :: Context -> Cipher -> TLS13TicketInfo -> Int -> ByteString -> IO SessionData
+getSessionData13 ctx usedCipher tinfo maxSize psk = do
+    ver <- usingState_ ctx getVersion
+    malpn <- usingState_ ctx getNegotiatedProtocol
+    sni <- usingState_ ctx getClientSNI
+    mgrp <- usingHState ctx getSupportedGroup
+    return
+        SessionData
+            { sessionVersion = ver
+            , sessionCipher = cipherID usedCipher
+            , sessionCompression = 0
+            , sessionClientSNI = sni
+            , sessionSecret = psk
+            , sessionGroup = mgrp
+            , sessionTicketInfo = Just tinfo
+            , sessionALPN = malpn
+            , sessionMaxEarlyDataSize = maxSize
+            , sessionFlags = []
+            }
+
+----------------------------------------------------------------
+
+-- Word32 is used in TLS 1.3 protocol.
+-- Int is used for API for Haskell TLS because it is natural.
+-- If Int is 64 bits, users can specify bigger number than Word32.
+-- If Int is 32 bits, 2^31 or larger may be converted into minus numbers.
+safeNonNegative32 :: (Num a, Ord a, FiniteBits a) => a -> a
+safeNonNegative32 x
+    | x <= 0 = 0
+    | finiteBitSize x <= 32 = x
+    | otherwise = x `min` fromIntegral (maxBound :: Word32)
+
+----------------------------------------------------------------
+
+newtype RecvHandshake13M m a
+    = RecvHandshake13M (StateT [Handshake13R] m a)
+    deriving (Functor, Applicative, Monad, MonadIO)
+
+recvHandshake13
+    :: MonadIO m
+    => Context
+    -> (Handshake13 -> RecvHandshake13M m a)
+    -> RecvHandshake13M m a
+recvHandshake13 ctx f = getHandshake13 ctx >>= \(h, _b) -> f h
+
+recvHandshake13hash
+    :: MonadIO m
+    => Context
+    -> String
+    -> (TranscriptHash -> Handshake13 -> RecvHandshake13M m a)
+    -> RecvHandshake13M m a
+recvHandshake13hash ctx label f = do
+    d <- transcriptHash ctx label
+    getHandshake13 ctx >>= \(h, _b) -> f d h
+
+getHandshake13
+    :: MonadIO m => Context -> RecvHandshake13M m Handshake13R
+getHandshake13 ctx = RecvHandshake13M $ do
+    currentState <- get
+    case currentState of
+        hb : hbs -> found hb hbs
+        _ -> recvLoop
+  where
+    found hb hbs = liftIO (updateTranscriptHash13 ctx hb) >> put hbs >> return hb
+    recvLoop = do
+        epkt <- liftIO (recvPacket13 ctx)
+        case epkt of
+            Right (Handshake13 [] _) -> error "invalid recvPacket13 result"
+            Right (Handshake13 (h : hs) (b : bs)) -> found (h, b) $ zip hs bs
+            Right ChangeCipherSpec13 -> do
+                alreadyReceived <- liftIO $ usingHState ctx getCCS13Recv
+                if alreadyReceived
+                    then
+                        liftIO $ throwCore $ Error_Protocol "multiple CSS in TLS 1.3" UnexpectedMessage
+                    else do
+                        liftIO $ usingHState ctx $ setCCS13Recv True
+                        recvLoop
+            Right (Alert13 _) -> throwCore Error_TCP_Terminate
+            Right x -> unexpected (show x) (Just "handshake 13")
+            Left err -> throwCore err
+
+runRecvHandshake13 :: MonadIO m => RecvHandshake13M m a -> m a
+runRecvHandshake13 (RecvHandshake13M f) = do
+    (result, new) <- runStateT f []
+    unless (null new) $ unexpected "spurious handshake 13" Nothing
+    return result
+
+----------------------------------------------------------------
+
+-- some hash/signature combinations have been deprecated in TLS13 and should
+-- not be used
+checkHashSignatureValid13 :: HashAndSignatureAlgorithm -> IO ()
+checkHashSignatureValid13 hs =
+    unless (isHashSignatureValid13 hs) $
+        let msg = "invalid TLS13 hash and signature algorithm: " ++ show hs
+         in throwCore $ Error_Protocol msg IllegalParameter
+
+isHashSignatureValid13 :: HashAndSignatureAlgorithm -> Bool
+isHashSignatureValid13 hs = hs `elem` signatureSchemesForTLS13
+
+{-
+isHashSignatureValid13 (HashIntrinsic, s) =
+    s
+        `elem` [ SignatureRSApssRSAeSHA256
+               , SignatureRSApssRSAeSHA384
+               , SignatureRSApssRSAeSHA512
+               , SignatureEd25519
+               , SignatureEd448
+               , SignatureRSApsspssSHA256
+               , SignatureRSApsspssSHA384
+               , SignatureRSApsspssSHA512
+               ]
+isHashSignatureValid13 (h, SignatureECDSA) =
+    h `elem` [HashSHA256, HashSHA384, HashSHA512]
+isHashSignatureValid13 _ = False
+-}
+
+----------------------------------------------------------------
+
+calculateEarlySecret
+    :: Context
+    -> CipherChoice
+    -> Either ByteString (BaseSecret EarlySecret)
+    -> IO (SecretPair EarlySecret)
+calculateEarlySecret ctx choice maux = do
+    (_ch, b) <- fromJust <$> usingHState ctx getClientHello
+    let hCh = TranscriptHash $ hashChunks usedHash b
+    let earlySecret = case maux of
+            Right (BaseSecret sec) -> sec
+            Left psk -> hkdfExtract usedHash zero (convert psk)
+        clientEarlySecret = deriveSecret usedHash earlySecret "c e traffic" hCh
+        cets = ClientTrafficSecret clientEarlySecret :: ClientTrafficSecret EarlySecret
+    logKey ctx cets
+    return $ SecretPair (BaseSecret earlySecret) cets
+  where
+    usedHash = cHash choice
+    zero = cZero choice
+
+initEarlySecret :: CipherChoice -> Maybe ByteString -> BaseSecret EarlySecret
+initEarlySecret choice mpsk = BaseSecret sec
+  where
+    sec = hkdfExtract usedHash zero zeroOrPSK
+    usedHash = cHash choice
+    zero = cZero choice
+    zeroOrPSK = fromMaybe zero (convert <$> mpsk)
+
+calculateHandshakeSecret
+    :: Context
+    -> CipherChoice
+    -> BaseSecret EarlySecret
+    -> Secret
+    -> IO (SecretTriple HandshakeSecret)
+calculateHandshakeSecret ctx choice (BaseSecret sec) ecdhe = do
+    hChSh <- transcriptHash ctx "CH..SH"
+    let th = TranscriptHash $ hash usedHash ""
+        handshakeSecret =
+            hkdfExtract
+                usedHash
+                (deriveSecret usedHash sec "derived" th)
+                ecdhe
+    let clientHandshakeSecret = deriveSecret usedHash handshakeSecret "c hs traffic" hChSh
+        serverHandshakeSecret = deriveSecret usedHash handshakeSecret "s hs traffic" hChSh
+    let shts =
+            ServerTrafficSecret serverHandshakeSecret :: ServerTrafficSecret HandshakeSecret
+        chts =
+            ClientTrafficSecret clientHandshakeSecret :: ClientTrafficSecret HandshakeSecret
+    logKey ctx shts
+    logKey ctx chts
+    return $ SecretTriple (BaseSecret handshakeSecret) chts shts
+  where
+    usedHash = cHash choice
+
+calculateApplicationSecret
+    :: Context
+    -> CipherChoice
+    -> BaseSecret HandshakeSecret
+    -> TranscriptHash
+    -> IO (SecretTriple ApplicationSecret)
+calculateApplicationSecret ctx choice (BaseSecret sec) hChSf = do
+    let th = TranscriptHash $ hash usedHash ""
+        applicationSecret =
+            hkdfExtract
+                usedHash
+                (deriveSecret usedHash sec "derived" th)
+                zero
+    let clientApplicationSecret0 = deriveSecret usedHash applicationSecret "c ap traffic" hChSf
+        serverApplicationSecret0 = deriveSecret usedHash applicationSecret "s ap traffic" hChSf
+        exporterSecret = deriveSecret usedHash applicationSecret "exp master" hChSf
+    usingState_ ctx $ setTLS13ExporterSecret exporterSecret
+    let sts0 =
+            ServerTrafficSecret serverApplicationSecret0
+                :: ServerTrafficSecret ApplicationSecret
+    let cts0 =
+            ClientTrafficSecret clientApplicationSecret0
+                :: ClientTrafficSecret ApplicationSecret
+    logKey ctx sts0
+    logKey ctx cts0
+    return $ SecretTriple (BaseSecret applicationSecret) cts0 sts0
+  where
+    usedHash = cHash choice
+    zero = cZero choice
+
+calculateResumptionSecret
+    :: Context
+    -> CipherChoice
+    -> BaseSecret ApplicationSecret
+    -> IO (BaseSecret ResumptionSecret)
+calculateResumptionSecret ctx choice (BaseSecret sec) = do
+    hChCf <- transcriptHash ctx "CH..CF"
+    let resumptionSecret = deriveSecret usedHash sec "res master" hChCf
+    return $ BaseSecret resumptionSecret
+  where
+    usedHash = cHash choice
+
+derivePSK
+    :: CipherChoice -> BaseSecret ResumptionSecret -> TicketNonce -> ByteString
+derivePSK choice (BaseSecret sec) (TicketNonce nonce) =
+    hkdfExpandLabel usedHash sec "resumption" nonce hashSize
+  where
+    usedHash = cHash choice
+    hashSize = hashDigestSize usedHash
+
+----------------------------------------------------------------
+
+checkClientKeyShareKeyLength :: KeyShareEntry -> Bool
+checkClientKeyShareKeyLength ks = clientKeyShareKeyLength grp == B.length key
+  where
+    grp = keyShareEntryGroup ks
+    key = keyShareEntryKeyExchange ks
+
+{- FOURMOLU_DISABLE -}
+clientKeyShareKeyLength :: Group -> Int
+clientKeyShareKeyLength P256   = 65  -- 32 * 2 + 1
+clientKeyShareKeyLength P384   = 97  -- 48 * 2 + 1
+clientKeyShareKeyLength P521   = 133 -- 66 * 2 + 1
+clientKeyShareKeyLength X25519 = 32
+clientKeyShareKeyLength X448   = 56
+clientKeyShareKeyLength FFDHE2048 = 256
+clientKeyShareKeyLength FFDHE3072 = 384
+clientKeyShareKeyLength FFDHE4096 = 512
+clientKeyShareKeyLength FFDHE6144 = 768
+clientKeyShareKeyLength FFDHE8192 = 1024
+clientKeyShareKeyLength MLKEM512  = 800
+clientKeyShareKeyLength MLKEM768  = 1184
+clientKeyShareKeyLength MLKEM1024 = 1568
+clientKeyShareKeyLength X25519MLKEM768 = 1216
+clientKeyShareKeyLength P256MLKEM768   = 1249
+clientKeyShareKeyLength P384MLKEM1024  = 1665
+clientKeyShareKeyLength _ = error "clientKeyShareKeyLength"
+{- FOURMOLU_ENABLE -}
+
+checkServerKeyShareKeyLength :: KeyShareEntry -> Bool
+checkServerKeyShareKeyLength ks = serverKeyShareKeyLength grp == B.length key
+  where
+    grp = keyShareEntryGroup ks
+    key = keyShareEntryKeyExchange ks
+
+{- FOURMOLU_DISABLE -}
+serverKeyShareKeyLength :: Group -> Int
+serverKeyShareKeyLength P256   = 65  -- 32 * 2 + 1
+serverKeyShareKeyLength P384   = 97  -- 48 * 2 + 1
+serverKeyShareKeyLength P521   = 133 -- 66 * 2 + 1
+serverKeyShareKeyLength X25519 = 32
+serverKeyShareKeyLength X448   = 56
+serverKeyShareKeyLength FFDHE2048 = 256
+serverKeyShareKeyLength FFDHE3072 = 384
+serverKeyShareKeyLength FFDHE4096 = 512
+serverKeyShareKeyLength FFDHE6144 = 768
+serverKeyShareKeyLength FFDHE8192 = 1024
+serverKeyShareKeyLength MLKEM512  = 768
+serverKeyShareKeyLength MLKEM768  = 1088
+serverKeyShareKeyLength MLKEM1024 = 1568
+serverKeyShareKeyLength X25519MLKEM768 = 1120
+serverKeyShareKeyLength P256MLKEM768   = 1153
+serverKeyShareKeyLength P384MLKEM1024  = 1665
+serverKeyShareKeyLength _ = error "clientKeyShareKeyLength"
+{- FOURMOLU_ENABLE -}
+
+setRTT :: Context -> Millisecond -> IO ()
+setRTT ctx chSentTime = do
+    shRecvTime <- getCurrentTimeFromBase
+    let rtt' = shRecvTime - chSentTime
+        rtt = if rtt' == 0 then 10 else rtt'
+    modifyTLS13State ctx $ \st -> st{tls13stRTT = rtt}
+
+computeConfirm
+    :: (MonadFail m, MonadIO m)
+    => Context -> Hash -> ServerHello -> ByteString -> m ByteString
+computeConfirm ctx usedHash sh label = do
+    (CH{..}, _b) <- fromJust <$> liftIO (usingHState ctx getClientHello)
+    TranscriptHash echConf <-
+        transcriptHashWith ctx "ECH acceptance" $ encodeHandshake13 $ ServerHello13 sh
+    let prk = hkdfExtract usedHash "" $ unClientRandom chRandom
+    return $ hkdfExpandLabel usedHash (convert prk) label echConf 8
+
+----------------------------------------------------------------
+
+setServerHelloParameters13
+    :: Context -> Cipher -> Bool -> IO (Either TLSError ())
+setServerHelloParameters13 ctx cipher isHRR = do
+    transitTranscriptHash ctx "transit" (cipherHash cipher) isHRR
+    usingHState ctx $ do
+        hst <- get
+        case hstPendingCipher hst of
+            Nothing -> do
+                put
+                    hst
+                        { hstPendingCipher = Just cipher
+                        , hstPendingCompression = nullCompression
+                        }
+                return $ Right ()
+            Just oldcipher
+                | cipher == oldcipher -> return $ Right ()
+                | otherwise ->
+                    return $
+                        Left $
+                            Error_Protocol "TLS 1.3 cipher changed after hello retry" IllegalParameter
+
+-- | TLS13 handshake wrap up & clean up.  Contrary to
+-- @finishHandshake12@, this does not handle session, which is managed
+-- separately for TLS 1.3.  This does not reset byte counters because
+-- renegotiation is not allowed.  And a few more state attributes are
+-- preserved, necessary for TLS13 handshake modes, session tickets and
+-- post-handshake authentication.
+finishHandshake13 :: Context -> IO ()
+finishHandshake13 ctx = do
+    -- forget most handshake data
+    modifyMVar_ (ctxHandshakeState ctx) $ \case
+        Nothing -> return Nothing
+        Just hshake ->
+            return $
+                Just
+                    (newEmptyHandshake (hstClientVersion hshake) (hstClientRandom hshake))
+                        { hstServerRandom = hstServerRandom hshake
+                        , hstMainSecret = hstMainSecret hshake
+                        , hstSupportedGroup = hstSupportedGroup hshake
+                        , hstTransHashState = hstTransHashState hshake
+                        , hstTLS13HandshakeMode = hstTLS13HandshakeMode hshake
+                        , hstTLS13RTT0Status = hstTLS13RTT0Status hshake
+                        , hstTLS13ResumptionSecret = hstTLS13ResumptionSecret hshake
+                        , hstTLS13ECHAccepted = hstTLS13ECHAccepted hshake
+                        }
+    -- forget handshake data stored in TLS state
+    usingState_ ctx $ do
+        setTLS13KeyShare Nothing
+        setTLS13PreSharedKey Nothing
+    -- mark the secure connection up and running.
+    setEstablished ctx Established
diff --git a/Network/TLS/Handshake/Control.hs b/Network/TLS/Handshake/Control.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Control.hs
@@ -0,0 +1,43 @@
+module Network.TLS.Handshake.Control (
+    ClientState (..),
+    ServerState (..),
+    EarlySecretInfo (..),
+    HandshakeSecretInfo (..),
+    ApplicationSecretInfo (..),
+    NegotiatedProtocol,
+) where
+
+import Network.TLS.Cipher
+import Network.TLS.Imports
+import Network.TLS.Struct
+import Network.TLS.Types
+
+----------------------------------------------------------------
+
+-- | ID of the application-level protocol negotiated between client and server.
+-- See values listed in the <https://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.xhtml#alpn-protocol-ids IANA registry>.
+type NegotiatedProtocol = ByteString
+
+-- | Handshake information generated for traffic at 0-RTT level.
+data EarlySecretInfo = EarlySecretInfo Cipher (ClientTrafficSecret EarlySecret)
+    deriving (Show)
+
+-- | Handshake information generated for traffic at handshake level.
+data HandshakeSecretInfo
+    = HandshakeSecretInfo Cipher (TrafficSecrets HandshakeSecret)
+    deriving (Show)
+
+-- | Handshake information generated for traffic at application level.
+newtype ApplicationSecretInfo = ApplicationSecretInfo (TrafficSecrets ApplicationSecret)
+    deriving (Show)
+
+----------------------------------------------------------------
+
+data ClientState
+    = SendClientHello (Maybe EarlySecretInfo)
+    | RecvServerHello HandshakeSecretInfo
+    | SendClientFinished [ExtensionRaw] ApplicationSecretInfo
+
+data ServerState
+    = SendServerHello [ExtensionRaw] (Maybe EarlySecretInfo) HandshakeSecretInfo
+    | SendServerFinished ApplicationSecretInfo
diff --git a/Network/TLS/Handshake/Key.hs b/Network/TLS/Handshake/Key.hs
--- a/Network/TLS/Handshake/Key.hs
+++ b/Network/TLS/Handshake/Key.hs
@@ -1,62 +1,182 @@
--- |
--- Module      : Network.TLS.Handshake.Key
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- functions for RSA operations
---
-module Network.TLS.Handshake.Key
-    ( encryptRSA
-    , signRSA
-    , decryptRSA
-    , verifyRSA
-    , generateDHE
-    ) where
+{-# LANGUAGE FlexibleInstances #-}
 
-import Data.ByteString (ByteString)
+-- | Functions for RSA operations
+module Network.TLS.Handshake.Key (
+    encryptRSA,
+    signPrivate,
+    decryptRSA,
+    verifyPublic,
+    generateDHE,
+    generateGroup,
+    encapsulateGroup,
+    generateFFDHE,
+    generateFFDHEShared,
+    versionCompatible,
+    isDigitalSignaturePair,
+    checkDigitalSignatureKey,
+    getLocalPublicKey,
+    satisfiesEcPredicate,
+    logKey,
+) where
+
+import Control.Monad.State.Strict
+import Data.ByteArray (convert)
 import qualified Data.ByteString as B
 
-import Network.TLS.Handshake.State
-import Network.TLS.State (withRNG, getVersion)
+import Network.TLS.Context.Internal
 import Network.TLS.Crypto
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.State (withRNG)
+import Network.TLS.Struct
 import Network.TLS.Types
-import Network.TLS.Context.Internal
+import Network.TLS.X509
 
 {- if the RSA encryption fails we just return an empty bytestring, and let the protocol
  - fail by itself; however it would be probably better to just report it since it's an internal problem.
  -}
-encryptRSA :: Context -> ByteString -> IO ByteString
+encryptRSA :: Context -> Secret -> IO ByteString
 encryptRSA ctx content = do
     publicKey <- usingHState ctx getRemotePublicKey
     usingState_ ctx $ do
-        v      <- withRNG (\g -> kxEncrypt g publicKey content)
+        v <- withRNG $ kxEncrypt publicKey content
         case v of
-            Left err       -> fail ("rsa encrypt failed: " ++ show err)
+            Left err -> error ("rsa encrypt failed: " ++ show err)
             Right econtent -> return econtent
 
-signRSA :: Context -> Role -> HashDescr -> ByteString -> IO ByteString
-signRSA ctx _ hsh content = do
-    privateKey <- usingHState ctx getLocalPrivateKey
+signPrivate :: Context -> Role -> SignatureParams -> ByteString -> IO ByteString
+signPrivate ctx _ params content = do
+    (publicKey, privateKey) <- usingHState ctx getLocalPublicPrivateKeys
     usingState_ ctx $ do
-        r      <- withRNG (\g -> kxSign g privateKey hsh content)
+        r <- withRNG $ kxSign privateKey publicKey params content
         case r of
-            Left err       -> fail ("rsa sign failed: " ++ show err)
+            Left err -> error ("sign failed: " ++ show err)
             Right econtent -> return econtent
 
-decryptRSA :: Context -> ByteString -> IO (Either KxError ByteString)
+decryptRSA :: Context -> ByteString -> IO (Either KxError Secret)
 decryptRSA ctx econtent = do
-    privateKey <- usingHState ctx getLocalPrivateKey
+    (_, privateKey) <- usingHState ctx getLocalPublicPrivateKeys
     usingState_ ctx $ do
-        ver     <- getVersion
-        let cipher = if ver < TLS10 then econtent else B.drop 2 econtent
-        withRNG (\g -> kxDecrypt g privateKey cipher)
+        let cipher = B.drop 2 econtent
+        withRNG $ kxDecrypt privateKey cipher
 
-verifyRSA :: Context -> Role -> HashDescr -> ByteString -> ByteString -> IO Bool
-verifyRSA ctx _ hsh econtent sign = do
+verifyPublic
+    :: Context -> SignatureParams -> ByteString -> ByteString -> IO Bool
+verifyPublic ctx params econtent sign = do
     publicKey <- usingHState ctx getRemotePublicKey
-    return $ kxVerify publicKey hsh econtent sign
+    return $ kxVerify publicKey params econtent sign
 
 generateDHE :: Context -> DHParams -> IO (DHPrivate, DHPublic)
-generateDHE ctx dhp = usingState_ ctx $ withRNG $ \rng -> dhGenerateKeyPair rng dhp
+generateDHE ctx dhp = usingState_ ctx $ withRNG $ dhGenerateKeyPair dhp
+
+generateGroup :: Context -> Group -> IO (GroupPrivate, GroupPublicA)
+generateGroup ctx grp = usingState_ ctx $ withRNG $ groupGenerateKeyPair grp
+
+encapsulateGroup
+    :: Context -> GroupPublicA -> IO (Maybe (GroupPublicB, GroupKey))
+encapsulateGroup ctx pub = usingState_ ctx $ withRNG $ groupEncapsulate pub
+
+generateFFDHE :: Context -> Group -> IO (DHParams, DHPrivate, DHPublic)
+generateFFDHE ctx grp = usingState_ ctx $ withRNG $ dhGroupGenerateKeyPair grp
+
+generateFFDHEShared
+    :: Context -> Group -> DHPublic -> IO (Maybe (DHPublic, DHKey))
+generateFFDHEShared ctx grp pub = usingState_ ctx $ withRNG $ dhGroupGetPubShared grp pub
+
+{- FOURMOLU_DISABLE -}
+isDigitalSignatureKey :: PubKey -> Bool
+isDigitalSignatureKey (PubKeyRSA _)     = True
+isDigitalSignatureKey (PubKeyDSA _)     = True
+isDigitalSignatureKey (PubKeyEC _)      = True
+isDigitalSignatureKey (PubKeyEd25519 _) = True
+isDigitalSignatureKey (PubKeyEd448 _)   = True
+isDigitalSignatureKey _                 = False
+
+versionCompatible :: PubKey -> Version -> Bool
+versionCompatible (PubKeyRSA _) _     = True
+versionCompatible (PubKeyDSA _) v     = v <= TLS12
+versionCompatible (PubKeyEC _) v      = v >= TLS10
+versionCompatible (PubKeyEd25519 _) v = v >= TLS12
+versionCompatible (PubKeyEd448 _) v   = v >= TLS12
+versionCompatible _ _                 = False
+{- FOURMOLU_ENABLE -}
+
+-- | Test whether the argument is a public key supported for signature at the
+-- specified TLS version.  This also accepts a key for RSA encryption.  This
+-- test is performed by clients or servers before verifying a remote
+-- Certificate Verify.
+checkDigitalSignatureKey :: MonadIO m => Version -> PubKey -> m ()
+checkDigitalSignatureKey usedVersion key = do
+    unless (isDigitalSignatureKey key) $
+        throwCore $
+            Error_Protocol "unsupported remote public key type" HandshakeFailure
+    unless (key `versionCompatible` usedVersion) $
+        throwCore $
+            Error_Protocol
+                (show usedVersion ++ " has no support for " ++ pubkeyType key)
+                IllegalParameter
+
+-- | Test whether the argument is matching key pair supported for signature.
+-- This also accepts material for RSA encryption.  This test is performed by
+-- servers or clients before using a credential from the local configuration.
+isDigitalSignaturePair :: (PubKey, PrivKey) -> Bool
+isDigitalSignaturePair keyPair =
+    case keyPair of
+        (PubKeyRSA _, PrivKeyRSA _) -> True
+        (PubKeyDSA _, PrivKeyDSA _) -> True
+        (PubKeyEC _, PrivKeyEC k) -> kxSupportedPrivKeyEC k
+        (PubKeyEd25519 _, PrivKeyEd25519 _) -> True
+        (PubKeyEd448 _, PrivKeyEd448 _) -> True
+        _ -> False
+
+getLocalPublicKey :: MonadIO m => Context -> m PubKey
+getLocalPublicKey ctx =
+    usingHState ctx (fst <$> getLocalPublicPrivateKeys)
+
+-- | Test whether the public key satisfies a predicate about the elliptic curve.
+-- When the public key is not suitable for ECDSA, like RSA for instance, the
+-- predicate is not used and the result is 'True'.
+satisfiesEcPredicate :: (Group -> Bool) -> PubKey -> Bool
+satisfiesEcPredicate p (PubKeyEC ecPub) =
+    maybe False p $ findEllipticCurveGroup ecPub
+satisfiesEcPredicate _ _ = True
+
+----------------------------------------------------------------
+
+class LogLabel a where
+    labelAndKey :: a -> (String, Secret)
+
+instance LogLabel MainSecret where
+    labelAndKey (MainSecret key) = ("CLIENT_RANDOM", key)
+
+instance LogLabel (ClientTrafficSecret EarlySecret) where
+    labelAndKey (ClientTrafficSecret key) = ("CLIENT_EARLY_TRAFFIC_SECRET", key)
+
+instance LogLabel (ServerTrafficSecret HandshakeSecret) where
+    labelAndKey (ServerTrafficSecret key) = ("SERVER_HANDSHAKE_TRAFFIC_SECRET", key)
+
+instance LogLabel (ClientTrafficSecret HandshakeSecret) where
+    labelAndKey (ClientTrafficSecret key) = ("CLIENT_HANDSHAKE_TRAFFIC_SECRET", key)
+
+instance LogLabel (ServerTrafficSecret ApplicationSecret) where
+    labelAndKey (ServerTrafficSecret key) = ("SERVER_TRAFFIC_SECRET_0", key)
+
+instance LogLabel (ClientTrafficSecret ApplicationSecret) where
+    labelAndKey (ClientTrafficSecret key) = ("CLIENT_TRAFFIC_SECRET_0", key)
+
+-- NSS Key Log Format
+-- See https://developer.mozilla.org/en-US/docs/Mozilla/Projects/NSS/Key_Log_Format
+logKey :: LogLabel a => Context -> a -> IO ()
+logKey ctx logkey = do
+    mhst <- getHState ctx
+    case mhst of
+        Nothing -> return ()
+        Just hst -> do
+            let crm = fromMaybe (hstClientRandom hst) (hstTLS13OuterClientRandom hst)
+                cr = unClientRandom crm
+                (label, key) = labelAndKey logkey
+            debugKeyLogger (ctxDebug ctx) $
+                label ++ " " ++ dump cr ++ " " ++ dump (convert key)
+  where
+    dump = init . drop 1 . showBytesHex
diff --git a/Network/TLS/Handshake/Process.hs b/Network/TLS/Handshake/Process.hs
deleted file mode 100644
--- a/Network/TLS/Handshake/Process.hs
+++ /dev/null
@@ -1,109 +0,0 @@
--- |
--- Module      : Network.TLS.Handshake.Process
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- process handshake message received
---
-module Network.TLS.Handshake.Process
-    ( processHandshake
-    , startHandshake
-    , getHandshakeDigest
-    ) where
-
-import Control.Applicative
-import Control.Concurrent.MVar
-import Control.Monad.Error
-import Control.Monad.State (gets)
-
-import Network.TLS.Types (Role(..), invertRole)
-import Network.TLS.Util
-import Network.TLS.Packet
-import Network.TLS.Struct
-import Network.TLS.State
-import Network.TLS.Context.Internal
-import Network.TLS.Crypto
-import Network.TLS.Handshake.State
-import Network.TLS.Handshake.Key
-import Network.TLS.Extension
-import Data.X509 (CertificateChain(..), Certificate(..), getCertificate)
-
-processHandshake :: Context -> Handshake -> IO ()
-processHandshake ctx hs = do
-    role <- usingState_ ctx isClientContext
-    case hs of
-        ClientHello cver ran _ _ _ ex _ -> when (role == ServerRole) $ do
-            mapM_ (usingState_ ctx . processClientExtension) ex
-            startHandshake ctx cver ran
-        Certificates certs            -> processCertificates role certs
-        ClientKeyXchg content         -> when (role == ServerRole) $ do
-            processClientKeyXchg ctx content
-        HsNextProtocolNegotiation selected_protocol ->
-            when (role == ServerRole) $ usingState_ ctx $ setNegotiatedProtocol selected_protocol
-        Finished fdata                -> processClientFinished ctx fdata
-        _                             -> return ()
-    let encoded = encodeHandshake hs
-    when (certVerifyHandshakeMaterial hs) $ usingHState ctx $ addHandshakeMessage encoded
-    when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ usingHState ctx $ updateHandshakeDigest encoded
-  where -- secure renegotiation
-        processClientExtension (0xff01, content) = do
-            v <- getVerifiedData ClientRole
-            let bs = extensionEncode (SecureRenegotiation v Nothing)
-            unless (bs `bytesEq` content) $ throwError $ Error_Protocol ("client verified data not matching: " ++ show v ++ ":" ++ show content, True, HandshakeFailure)
-
-            setSecureRenegotiation True
-        -- unknown extensions
-        processClientExtension _ = return ()
-
-        processCertificates :: Role -> CertificateChain -> IO ()
-        processCertificates ServerRole (CertificateChain []) = return ()
-        processCertificates ClientRole (CertificateChain []) =
-            throwCore $ Error_Protocol ("server certificate missing", True, HandshakeFailure)
-        processCertificates _ (CertificateChain (c:_)) =
-            usingHState ctx $ setPublicKey pubkey
-          where pubkey = certPubKey $ getCertificate c
-
--- process the client key exchange message. the protocol expects the initial
--- client version received in ClientHello, not the negotiated version.
--- in case the version mismatch, generate a random master secret
-processClientKeyXchg :: Context -> ClientKeyXchgAlgorithmData -> IO ()
-processClientKeyXchg ctx (CKX_RSA encryptedPremaster) = do
-    (rver, role, random) <- usingState_ ctx $ do
-        (,,) <$> getVersion <*> isClientContext <*> genRandom 48
-    ePremaster <- decryptRSA ctx encryptedPremaster
-    usingHState ctx $ do
-        expectedVer <- gets hstClientVersion
-        case ePremaster of
-            Left _          -> setMasterSecretFromPre rver role random
-            Right premaster -> case decodePreMasterSecret premaster of
-                Left _                   -> setMasterSecretFromPre rver role random
-                Right (ver, _)
-                    | ver /= expectedVer -> setMasterSecretFromPre rver role random
-                    | otherwise          -> setMasterSecretFromPre rver role premaster
-processClientKeyXchg ctx (CKX_DH clientDHValue) = do
-    rver <- usingState_ ctx getVersion
-    role <- usingState_ ctx isClientContext
-
-    (ServerDHParams dhparams _) <- fromJust "server dh params" <$> usingHState ctx (gets hstServerDHParams)
-    dhpriv                      <- fromJust "dh private" <$> usingHState ctx (gets hstDHPrivate)
-    let premaster = dhGetShared dhparams dhpriv clientDHValue
-    usingHState ctx $ setMasterSecretFromPre rver role premaster
-
-processClientFinished :: Context -> FinishedData -> IO ()
-processClientFinished ctx fdata = do
-    (cc,ver) <- usingState_ ctx $ (,) <$> isClientContext <*> getVersion
-    expected <- usingHState ctx $ getHandshakeDigest ver $ invertRole cc
-    when (expected /= fdata) $ do
-        throwCore $ Error_Protocol("bad record mac", True, BadRecordMac)
-    usingState_ ctx $ updateVerifiedData ServerRole fdata
-    return ()
-
-startHandshake :: Context -> Version -> ClientRandom -> IO ()
-startHandshake ctx ver crand = do
-    -- FIXME check if handshake is already not null
-    liftIO $ modifyMVar_ (ctxHandshake ctx) $ \hs ->
-        case hs of
-            Nothing -> return $ Just $ newEmptyHandshake ver crand
-            Just _  -> return hs
diff --git a/Network/TLS/Handshake/Random.hs b/Network/TLS/Handshake/Random.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Random.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternGuards #-}
+
+module Network.TLS.Handshake.Random (
+    serverRandom,
+    serverRandomECH,
+    replaceServerRandomECH,
+    clientRandom,
+    isDowngraded,
+) where
+
+import qualified Data.ByteString as B
+
+import Network.TLS.Context.Internal
+import Network.TLS.Imports
+import Network.TLS.Struct
+
+-- | Generate a server random suitable for the version selected by the server
+-- and its supported versions.  We use an 8-byte downgrade suffix when the
+-- selected version is lowered because of incomplete client support, but also
+-- when a version downgrade has been forced with 'debugVersionForced'.  This
+-- second part allows to test that the client implementation correctly detects
+-- downgrades.  The suffix is not used when forcing TLS13 to a server not
+-- officially supporting TLS13 (this is not a downgrade scenario but only the
+-- consequence of our debug API allowing this).
+serverRandom :: Context -> Version -> [Version] -> IO ServerRandom
+serverRandom ctx chosenVer suppVers
+    | TLS13 `elem` suppVers = case chosenVer of
+        TLS13 -> ServerRandom <$> getStateRNG ctx 32
+        TLS12 -> ServerRandom <$> genServRand suffix12
+        _ -> ServerRandom <$> genServRand suffix11
+    | TLS12 `elem` suppVers = case chosenVer of
+        TLS13 -> ServerRandom <$> getStateRNG ctx 32
+        TLS12 -> ServerRandom <$> getStateRNG ctx 32
+        _ -> ServerRandom <$> genServRand suffix11
+    | otherwise = ServerRandom <$> getStateRNG ctx 32
+  where
+    genServRand suff = do
+        pref <- getStateRNG ctx 24
+        return (pref `B.append` suff)
+
+serverRandomECH :: Context -> IO ServerRandom
+serverRandomECH ctx = do
+    rnd <- getStateRNG ctx 24
+    let zeros = "\x00\x00\x00\x00\x00\x00\x00\x00"
+    return $ ServerRandom (rnd <> zeros)
+
+replaceServerRandomECH :: ServerRandom -> ByteString -> ServerRandom
+replaceServerRandomECH (ServerRandom rnd) bs = ServerRandom (rnd' <> bs)
+  where
+    rnd' = B.take 24 rnd
+
+-- | Test if the negotiated version was artificially downgraded (that is, for
+-- other reason than the versions supported by the client).
+isDowngraded :: Version -> [Version] -> ServerRandom -> Bool
+isDowngraded ver suppVers (ServerRandom sr)
+    | ver <= TLS12
+    , TLS13 `elem` suppVers =
+        suffix12 `B.isSuffixOf` sr
+            || suffix11 `B.isSuffixOf` sr
+    | ver <= TLS11
+    , TLS12 `elem` suppVers =
+        suffix11 `B.isSuffixOf` sr
+    | otherwise = False
+
+suffix12 :: ByteString
+suffix12 = "\x44\x4F\x57\x4E\x47\x52\x44\x01"
+
+suffix11 :: ByteString
+suffix11 = "\x44\x4F\x57\x4E\x47\x52\x44\x00"
+
+clientRandom :: Context -> IO ClientRandom
+clientRandom ctx = ClientRandom <$> getStateRNG ctx 32
diff --git a/Network/TLS/Handshake/Server.hs b/Network/TLS/Handshake/Server.hs
--- a/Network/TLS/Handshake/Server.hs
+++ b/Network/TLS/Handshake/Server.hs
@@ -1,44 +1,29 @@
-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
--- |
--- Module      : Network.TLS.Handshake.Server
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Handshake.Server
-    ( handshakeServer
-    , handshakeServerWith
-    ) where
+{-# LANGUAGE OverloadedStrings #-}
 
-import Network.TLS.Parameters
-import Network.TLS.Context.Internal
-import Network.TLS.Session
-import Network.TLS.Struct
-import Network.TLS.Cipher
-import Network.TLS.Compression
-import Network.TLS.Credentials
-import Network.TLS.Extension
-import Network.TLS.Util (catchException, fromJust)
-import Network.TLS.IO
-import Network.TLS.Types
-import Network.TLS.State hiding (getNegotiatedProtocol)
-import Network.TLS.Handshake.State
-import Network.TLS.Handshake.Process
-import Network.TLS.Handshake.Key
-import Network.TLS.Measurement
-import Data.Maybe (isJust)
-import Data.List (intersect, sortBy)
-import qualified Data.ByteString as B
-import Data.ByteString.Char8 ()
+module Network.TLS.Handshake.Server (
+    handshakeServer,
+    handshakeServerWith,
+    requestCertificateServer,
+    keyUpdate,
+    updateKey,
+    KeyUpdateRequest (..),
+) where
 
-import Control.Applicative ((<$>))
-import Control.Monad.State
+import Control.Monad.State.Strict
+import Data.Maybe
 
-import Network.TLS.Handshake.Signature
+import Network.TLS.Context.Internal
 import Network.TLS.Handshake.Common
-import Network.TLS.Handshake.Certificate
-import Network.TLS.X509
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Server.ClientHello
+import Network.TLS.Handshake.Server.ClientHello12
+import Network.TLS.Handshake.Server.ClientHello13
+import Network.TLS.Handshake.Server.ServerHello12
+import Network.TLS.Handshake.Server.ServerHello13
+import Network.TLS.Handshake.Server.TLS12
+import Network.TLS.Handshake.Server.TLS13
+import Network.TLS.Imports
+import Network.TLS.Struct
 
 -- Put the server context in handshake mode.
 --
@@ -46,325 +31,59 @@
 --
 -- This is just a helper to pop the next message from the recv layer,
 -- and call handshakeServerWith.
-handshakeServer :: MonadIO m => ServerParams -> Context -> m ()
+handshakeServer :: ServerParams -> Context -> IO ()
 handshakeServer sparams ctx = liftIO $ do
-    hss <- recvPacketHandshake ctx
-    case hss of
-        [ch] -> handshakeServerWith sparams ctx ch
-        _    -> fail ("unexpected handshake received, excepting client hello and received " ++ show hss)
+    hbs <- recvPacketHandshake ctx
+    case hbs of
+        chb : _ -> handshake sparams ctx chb
+        _ -> unexpected (show $ fst $ unzip hbs) (Just "client hello")
 
+handshakeServerWith
+    :: ServerParams -> Context -> HandshakeR -> IO ()
+handshakeServerWith = handshake
+
 -- | Put the server context in handshake mode.
 --
 -- Expect a client hello message as parameter.
--- This is useful when the client hello has been already poped from the recv layer to inspect the packet.
+-- This is useful when the client hello has been already popped from the recv layer to inspect the packet.
 --
--- When the function returns, a new handshake has been succesfully negociated.
+-- When the function returns, a new handshake has been successfully negotiated.
 -- On any error, a HandshakeFailed exception is raised.
---
--- handshake protocol (<- receiving, -> sending, [] optional):
---    (no session)           (session resumption)
---      <- client hello       <- client hello
---      -> server hello       -> server hello
---      -> [certificate]
---      -> [server key xchg]
---      -> [cert request]
---      -> hello done
---      <- [certificate]
---      <- client key xchg
---      <- [cert verify]
---      <- change cipher      -> change cipher
---      <- [NPN]
---      <- finish             -> finish
---      -> change cipher      <- change cipher
---      -> finish             <- finish
---
-handshakeServerWith :: ServerParams -> Context -> Handshake -> IO ()
-handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientSession ciphers compressions exts _) = do
-    -- check if policy allow this new handshake to happens
-    handshakeAuthorized <- withMeasure ctx (onNewHandshake $ serverHooks sparams)
-    unless handshakeAuthorized (throwCore $ Error_HandshakePolicy "server: handshake denied")
-    updateMeasure ctx incrementNbHandshakes
-
-    -- Handle Client hello
-    processHandshake ctx clientHello
-
-    when (clientVersion == SSL2) $ throwCore $ Error_Protocol ("ssl2 is not supported", True, ProtocolVersion)
-    chosenVersion <- case findHighestVersionFrom clientVersion (supportedVersions $ ctxSupported ctx) of
-                        Nothing -> throwCore $ Error_Protocol ("client version " ++ show clientVersion ++ " is not supported", True, ProtocolVersion)
-                        Just v  -> return v
-
-    when (commonCipherIDs == []) $ throwCore $
-        Error_Protocol ("no cipher in common with the client", True, HandshakeFailure)
-    when (null commonCompressions) $ throwCore $
-        Error_Protocol ("no compression in common with the client", True, HandshakeFailure)
-
-    let ciphersFilteredVersion = filter (cipherAllowedForVersion chosenVersion) commonCiphers
-        usedCipher = (onCipherChoosing $ serverHooks sparams) chosenVersion ciphersFilteredVersion
-        creds = sharedCredentials $ ctxShared ctx
-    cred <- case cipherKeyExchange usedCipher of
-                CipherKeyExchange_RSA     -> return $ credentialsFindForDecrypting creds
-                CipherKeyExchange_DH_Anon -> return $ Nothing
-                CipherKeyExchange_DHE_RSA -> return $ credentialsFindForSigning SignatureRSA creds
-                CipherKeyExchange_DHE_DSS -> return $ credentialsFindForSigning SignatureDSS creds
-                _                         -> throwCore $ Error_Protocol ("key exchange algorithm not implemented", True, HandshakeFailure)
-
-    resumeSessionData <- case clientSession of
-            (Session (Just clientSessionId)) -> liftIO $ sessionResume (sharedSessionManager $ ctxShared ctx) clientSessionId
-            (Session Nothing)                -> return Nothing
-
-    doHandshake sparams cred ctx chosenVersion usedCipher usedCompression clientSession resumeSessionData exts
-
-  where
-        commonCipherIDs    = intersect ciphers (map cipherID $ ctxCiphers ctx)
-        commonCiphers      = filter (flip elem commonCipherIDs . cipherID) (ctxCiphers ctx)
-        commonCompressions = compressionIntersectID (supportedCompressions $ ctxSupported ctx) compressions
-        usedCompression    = head commonCompressions
-
-
-handshakeServerWith _ _ _ = throwCore $ Error_Protocol ("unexpected handshake message received in handshakeServerWith", True, HandshakeFailure)
-
-doHandshake :: ServerParams -> Maybe Credential -> Context -> Version -> Cipher
-            -> Compression -> Session -> Maybe SessionData
-            -> [(ExtensionID, a)] -> IO ()
-doHandshake sparams mcred ctx chosenVersion usedCipher usedCompression clientSession resumeSessionData exts = do
-    case resumeSessionData of
-        Nothing -> do
-            handshakeSendServerData
-            liftIO $ contextFlush ctx
-            -- Receive client info until client Finished.
-            recvClientData sparams ctx
-            sendChangeCipherAndFinish (return ()) ctx ServerRole
-        Just sessionData -> do
-            usingState_ ctx (setSession clientSession True)
-            serverhello <- makeServerHello clientSession
-            sendPacket ctx $ Handshake [serverhello]
-            usingHState ctx $ setMasterSecret chosenVersion ServerRole $ sessionSecret sessionData
-            sendChangeCipherAndFinish (return ()) ctx ServerRole
-            recvChangeCipherAndFinish ctx
-    handshakeTerminate ctx
-  where
-        clientRequestedNPN = isJust $ lookup extensionID_NextProtocolNegotiation exts
-
-        ---
-        -- When the client sends a certificate, check whether
-        -- it is acceptable for the application.
-        --
-        ---
-        makeServerHello session = do
-            srand <- getStateRNG ctx 32 >>= return . ServerRandom
-            case mcred of
-                Just (_, privkey) -> usingHState ctx $ setPrivateKey privkey
-                _                 -> return () -- return a sensible error
-
-            -- in TLS12, we need to check as well the certificates we are sending if they have in the extension
-            -- the necessary bits set.
-            secReneg   <- usingState_ ctx getSecureRenegotiation
-            secRengExt <- if secReneg
-                    then do
-                            vf <- usingState_ ctx $ do
-                                    cvf <- getVerifiedData ClientRole
-                                    svf <- getVerifiedData ServerRole
-                                    return $ extensionEncode (SecureRenegotiation cvf $ Just svf)
-                            return [ (0xff01, vf) ]
-                    else return []
-            nextProtocols <-
-                if clientRequestedNPN
-                    then liftIO $ onSuggestNextProtocols $ serverHooks sparams
-                    else return Nothing
-            npnExt <- case nextProtocols of
-                        Just protos -> do usingState_ ctx $ do setExtensionNPN True
-                                                               setServerNextProtocolSuggest protos
-                                          return [ ( extensionID_NextProtocolNegotiation
-                                                   , extensionEncode $ NextProtocolNegotiation protos) ]
-                        Nothing -> return []
-            let extensions = secRengExt ++ npnExt
-            usingState_ ctx (setVersion chosenVersion)
-            usingHState ctx $ setServerHelloParameters chosenVersion srand usedCipher usedCompression
-            return $ ServerHello chosenVersion srand session (cipherID usedCipher)
-                                               (compressionID usedCompression) extensions
-
-        handshakeSendServerData = do
-            serverSession <- newSession ctx
-            usingState_ ctx (setSession serverSession False)
-            serverhello   <- makeServerHello serverSession
-            -- send ServerHello & Certificate & ServerKeyXchg & CertReq
-            let certMsg = case mcred of
-                            Just (srvCerts, _) -> Certificates srvCerts
-                            _                  -> Certificates $ CertificateChain []
-            sendPacket ctx $ Handshake [ serverhello, certMsg ]
-
-            -- send server key exchange if needed
-            skx <- case cipherKeyExchange usedCipher of
-                        CipherKeyExchange_DH_Anon -> Just <$> generateSKX_DH_Anon
-                        CipherKeyExchange_DHE_RSA -> Just <$> generateSKX_DHE SignatureRSA
-                        CipherKeyExchange_DHE_DSS -> Just <$> generateSKX_DHE SignatureDSS
-                        _                         -> return Nothing
-            maybe (return ()) (sendPacket ctx . Handshake . (:[]) . ServerKeyXchg) skx
-
-            -- FIXME we don't do this on a Anonymous server
-
-            -- When configured, send a certificate request
-            -- with the DNs of all confgure CA
-            -- certificates.
-            --
-            when (serverWantClientCert sparams) $ do
-                usedVersion <- usingState_ ctx getVersion
-                let certTypes = [ CertificateType_RSA_Sign ]
-                    hashSigs = if usedVersion < TLS12
-                                   then Nothing
-                                   else Just (supportedHashSignatures $ ctxSupported ctx)
-                    creq = CertRequest certTypes hashSigs
-                               (map extractCAname $ serverCACertificates sparams)
-                usingHState ctx $ setCertReqSent True
-                sendPacket ctx (Handshake [creq])
-
-            -- Send HelloDone
-            sendPacket ctx (Handshake [ServerHelloDone])
-
-        extractCAname :: SignedCertificate -> DistinguishedName
-        extractCAname cert = certSubjectDN $ getCertificate cert
-
-        setup_DHE = do
-            let dhparams = fromJust "server DHE Params" $ serverDHEParams sparams
-            (priv, pub) <- generateDHE ctx dhparams
-
-            let serverParams = ServerDHParams dhparams pub
-
-            usingHState ctx $ setServerDHParams serverParams
-            usingHState ctx $ modify $ \hst -> hst { hstDHPrivate = Just priv }
-            return (serverParams)
-
-        generateSKX_DHE sigAlg = do
-            serverParams  <- setup_DHE
-            signatureData <- generateSignedDHParams ctx serverParams
-
-            usedVersion <- usingState_ ctx getVersion
-            let mhash = case usedVersion of
-                            TLS12 -> case filter ((==) sigAlg . snd) $ supportedHashSignatures $ ctxSupported ctx of
-                                          []  -> error ("no hash signature for " ++ show sigAlg)
-                                          x:_ -> Just (fst x)
-                            _     -> Nothing
-            let hashDescr = signatureHashData sigAlg mhash
-            signed <- signatureCreate ctx (fmap (\h -> (h, sigAlg)) mhash) hashDescr signatureData
-
-            case sigAlg of
-                SignatureRSA -> return $ SKX_DHE_RSA serverParams signed
-                SignatureDSS -> return $ SKX_DHE_DSS serverParams signed
-                _            -> error ("generate skx_dhe unsupported signature type: " ++ show sigAlg)
-
-        generateSKX_DH_Anon = SKX_DH_Anon <$> setup_DHE
-
--- | receive Client data in handshake until the Finished handshake.
---
---      <- [certificate]
---      <- client key xchg
---      <- [cert verify]
---      <- change cipher
---      <- [NPN]
---      <- finish
---
-recvClientData :: ServerParams -> Context -> IO ()
-recvClientData sparams ctx = runRecvState ctx (RecvStateHandshake processClientCertificate)
-  where processClientCertificate (Certificates certs) = do
-            -- run certificate recv hook
-            ctxWithHooks ctx (\hooks -> hookRecvCertificates hooks $ certs)
-            -- Call application callback to see whether the
-            -- certificate chain is acceptable.
-            --
-            usage <- liftIO $ catchException (onClientCertificate (serverHooks sparams) certs) rejectOnException
-            case usage of
-                CertificateUsageAccept        -> return ()
-                CertificateUsageReject reason -> certificateRejected reason
-
-            -- Remember cert chain for later use.
-            --
-            usingHState ctx $ setClientCertChain certs
-
-            -- FIXME: We should check whether the certificate
-            -- matches our request and that we support
-            -- verifying with that certificate.
-
-            return $ RecvStateHandshake processClientKeyExchange
-
-        processClientCertificate p = processClientKeyExchange p
-
-        -- cannot use RecvStateHandshake, as the next message could be a ChangeCipher,
-        -- so we must process any packet, and in case of handshake call processHandshake manually.
-        processClientKeyExchange (ClientKeyXchg _) = return $ RecvStateNext processCertificateVerify
-        processClientKeyExchange p                 = unexpected (show p) (Just "client key exchange")
-
-        -- Check whether the client correctly signed the handshake.
-        -- If not, ask the application on how to proceed.
-        --
-        processCertificateVerify (Handshake [hs@(CertVerify dsig@(DigitallySigned mbHashSig _))]) = do
-            processHandshake ctx hs
-
-            checkValidClientCertChain "change cipher message expected"
-
-            usedVersion <- usingState_ ctx getVersion
-            -- Fetch all handshake messages up to now.
-            msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
-            (hashMethod, toVerify) <- prepareCertificateVerifySignatureData ctx usedVersion mbHashSig msgs
-
-            -- Verify the signature.
-            verif <- signatureVerifyWithHashDescr ctx SignatureRSA hashMethod toVerify dsig
-
-            case verif of
-                True -> do
-                    -- When verification succeeds, commit the
-                    -- client certificate chain to the context.
-                    --
-                    Just certs <- usingHState ctx $ getClientCertChain
-                    usingState_ ctx $ setClientCertificateChain certs
-                    return ()
-
-                False -> do
-                    -- Either verification failed because of an
-                    -- invalid format (with an error message), or
-                    -- the signature is wrong.  In either case,
-                    -- ask the application if it wants to
-                    -- proceed, we will do that.
-                    res <- liftIO $ onUnverifiedClientCert (serverHooks sparams)
-                    if res
-                        then do
-                            -- When verification fails, but the
-                            -- application callbacks accepts, we
-                            -- also commit the client certificate
-                            -- chain to the context.
-                            Just certs <- usingHState ctx $ getClientCertChain
-                            usingState_ ctx $ setClientCertificateChain certs
-                        else throwCore $ Error_Protocol ("verification failed", True, BadCertificate)
-            return $ RecvStateNext expectChangeCipher
-
-        processCertificateVerify p = do
-            chain <- usingHState ctx $ getClientCertChain
-            case chain of
-                Just cc | isNullCertificateChain cc -> return ()
-                        | otherwise                 -> throwCore $ Error_Protocol ("cert verify message missing", True, UnexpectedMessage)
-                Nothing -> return ()
-            expectChangeCipher p
-
-        expectChangeCipher ChangeCipherSpec = do
-            npn <- usingState_ ctx getExtensionNPN
-            return $ RecvStateHandshake $ if npn then expectNPN else expectFinish
-        expectChangeCipher p                = unexpected (show p) (Just "change cipher")
-
-        expectNPN (HsNextProtocolNegotiation _) = return $ RecvStateHandshake expectFinish
-        expectNPN p                             = unexpected (show p) (Just "Handshake NextProtocolNegotiation")
-
-        expectFinish (Finished _) = return RecvStateDone
-        expectFinish p            = unexpected (show p) (Just "Handshake Finished")
-
-        checkValidClientCertChain msg = do
-            chain <- usingHState ctx $ getClientCertChain
-            let throwerror = Error_Protocol (msg , True, UnexpectedMessage)
-            case chain of
-                Nothing -> throwCore throwerror
-                Just cc | isNullCertificateChain cc -> throwCore throwerror
-                        | otherwise                 -> return ()
-
-findHighestVersionFrom :: Version -> [Version] -> Maybe Version
-findHighestVersionFrom clientVersion allowedVersions =
-    case filter (clientVersion >=) $ reverse $ sortBy compare allowedVersions of
-        []  -> Nothing
-        v:_ -> Just v
+handshake :: ServerParams -> Context -> HandshakeR -> IO ()
+handshake sparams ctx chb@(ClientHello ch, bs) = do
+    (chosenVersion, chI, mcrnd) <- processClientHello sparams ctx ch bs
+    if chosenVersion == TLS13
+        then do
+            -- fixme: we should check if the client random is the same as
+            -- that in the first client hello in the case of hello retry.
+            -- r0 :: Cipher, Hash, Bool
+            (keyShareResult, r0, r1) <-
+                processClientHello13 sparams ctx chI
+            case keyShareResult of
+                SelectKeyShareNotFound ->
+                    throwCore $
+                        Error_Protocol "no group in common with the client for HRR" HandshakeFailure
+                SelectKeyShareHRR g -> do
+                    sendHRR ctx g r0 chI $ isJust mcrnd
+                    -- Don't reset ctxEstablished since 0-RTT data
+                    -- would be coming, which should be ignored.
+                    handshakeServer sparams ctx
+                SelectKeyShareFound cliKeyShare -> do
+                    unless (checkClientKeyShareKeyLength cliKeyShare) $
+                        throwCore $
+                            Error_Protocol "broken key_share" IllegalParameter
+                    -- r2 :: ( SecretTriple ApplicationSecret
+                    --       , ClientTrafficSecret HandshakeSecret
+                    --       , Bool  -- authenticated
+                    --       , Bool) -- rtt0OK
+                    r2 <-
+                        sendServerHello13 sparams ctx cliKeyShare r0 r1 chI mcrnd
+                    recvClientSecondFlight13 sparams ctx r2 chI
+        else do
+            r <-
+                processClientHello12 sparams ctx chI
+            updateTranscriptHash12 ctx chb
+            resumeSessionData <-
+                sendServerHello12 sparams ctx r chI
+            recvClientSecondFlight12 sparams ctx resumeSessionData
+handshake _ _ _ = throwCore $ Error_Protocol "client Hello is expected" HandshakeFailure
diff --git a/Network/TLS/Handshake/Server/ClientHello.hs b/Network/TLS/Handshake/Server/ClientHello.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/ClientHello.hs
@@ -0,0 +1,305 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+
+module Network.TLS.Handshake.Server.ClientHello (
+    processClientHello,
+) where
+
+import qualified Control.Exception as E
+import Crypto.HPKE
+import qualified Data.ByteString as BS
+
+import Network.TLS.ECH.Config
+
+import Network.TLS.Compression
+import Network.TLS.Context.Internal
+import Network.TLS.Extension
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Measurement
+import Network.TLS.Packet
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Types
+
+processClientHello
+    :: ServerParams
+    -> Context
+    -> ClientHello
+    -> [ByteString]
+    -> IO
+        ( Version
+        , ClientHello
+        , Maybe ClientRandom -- Just for ECH to keep the outer one for key log
+        )
+processClientHello sparams ctx ch@CH{..} b = do
+    established <- ctxEstablished ctx
+    -- renego is not allowed in TLS 1.3
+    when (established /= NotEstablished) $ do
+        ver <- usingState_ ctx (getVersionWithDefault TLS12)
+        when (ver == TLS13) $
+            throwCore $
+                Error_Protocol "renegotiation is not allowed in TLS 1.3" UnexpectedMessage
+    -- rejecting client initiated renegotiation to prevent DOS.
+    eof <- ctxEOF ctx
+    let renegotiation = established == Established && not eof
+    when
+        (renegotiation && not (supportedClientInitiatedRenegotiation $ ctxSupported ctx))
+        $ throwCore
+        $ Error_Protocol_Warning "renegotiation is not allowed" NoRenegotiation
+    -- check if policy allow this new handshake to happens
+    handshakeAuthorized <- withMeasure ctx (onNewHandshake $ serverHooks sparams)
+    unless
+        handshakeAuthorized
+        (throwCore $ Error_HandshakePolicy "server: handshake denied")
+    updateMeasure ctx incrementNbHandshakes
+
+    when (chVersion /= TLS12) $
+        throwCore $
+            Error_Protocol (show chVersion ++ " is not supported") ProtocolVersion
+
+    -- Fallback SCSV: RFC7507
+    -- TLS_FALLBACK_SCSV: {0x56, 0x00}
+    when
+        ( supportedFallbackScsv (ctxSupported ctx)
+            && (CipherId 0x5600 `elem` chCiphers)
+            && chVersion < TLS12
+        )
+        $ throwCore
+        $ Error_Protocol "fallback is not allowed" InappropriateFallback
+
+    -- choosing TLS version
+    let extract (SupportedVersionsClientHello vers) = vers -- fixme: vers == []
+        extract _ = []
+        clientVersions =
+            lookupAndDecode EID_SupportedVersions MsgTClientHello chExtensions [] extract
+        clientVersion = min TLS12 chVersion
+        serverVersions
+            | renegotiation = filter (< TLS13) (supportedVersions $ ctxSupported ctx)
+            | otherwise = supportedVersions $ ctxSupported ctx
+        mVersion = debugVersionForced $ serverDebug sparams
+    chosenVersion <- case mVersion of
+        Just cver -> return cver
+        Nothing ->
+            if (TLS13 `elem` serverVersions) && clientVersions /= []
+                then case findHighestVersionFrom13 clientVersions serverVersions of
+                    Nothing ->
+                        throwCore $
+                            Error_Protocol
+                                ("client versions " ++ show clientVersions ++ " is not supported")
+                                ProtocolVersion
+                    Just v -> return v
+                else case findHighestVersionFrom clientVersion serverVersions of
+                    Nothing ->
+                        throwCore $
+                            Error_Protocol
+                                ("client version " ++ show clientVersion ++ " is not supported")
+                                ProtocolVersion
+                    Just v -> return v
+
+    -- Checking compression
+    let nullComp = compressionID nullCompression
+    case chosenVersion of
+        TLS13 ->
+            when (chComps /= [nullComp]) $
+                throwCore $
+                    Error_Protocol "compression is not allowed in TLS 1.3" IllegalParameter
+        _ -> case find (== nullComp) chComps of
+            Nothing ->
+                throwCore $
+                    Error_Protocol
+                        "compressions must include nullCompression in TLS 1.2"
+                        IllegalParameter
+            _ -> return ()
+
+    -- Processing encrypted client hello
+    (mClientHello', receivedECH) <-
+        if chosenVersion == TLS13 && not (null (serverECHKey sparams))
+            then do
+                lookupAndDecodeAndDo
+                    EID_EncryptedClientHello
+                    MsgTClientHello
+                    chExtensions
+                    (return (Nothing, False))
+                    (\bs -> (,True) <$> decryptECH sparams ctx ch bs)
+            else return (Nothing, False)
+    case mClientHello' of
+        Just chI -> do
+            -- chI is created from diff.
+            -- encodeHandshake is a MUST.
+            setupI ctx chI $ [encodeHandshake $ ClientHello chI]
+            return (chosenVersion, chI, Just chRandom)
+        _ -> do
+            setupO ctx ch b
+            when (chosenVersion == TLS13) $ do
+                let hasECHConf = not (null (sharedECHConfigList (serverShared sparams)))
+                when (hasECHConf && not receivedECH) $
+                    usingHState ctx $
+                        setECHEE True
+                when receivedECH $
+                    usingHState ctx $
+                        setECHEE True
+            return (chosenVersion, ch, Nothing)
+
+setupI :: Context -> ClientHello -> [ByteString] -> IO ()
+setupI ctx chI@CH{..} b = do
+    hrr <- usingState_ ctx getTLS13HRR
+    unless hrr $ startHandshake ctx TLS13 chRandom
+    usingHState ctx $ setClientHello chI b
+    let serverName = getServerName chExtensions
+    maybe (return ()) (usingState_ ctx . setClientSNI) serverName
+
+setupO :: Context -> ClientHello -> [ByteString] -> IO ()
+setupO ctx ch@CH{..} b = do
+    hrr <- usingState_ ctx getTLS13HRR
+    unless hrr $ startHandshake ctx chVersion chRandom
+    usingHState ctx $ setClientHello ch b
+    let serverName = getServerName chExtensions
+    maybe (return ()) (usingState_ ctx . setClientSNI) serverName
+
+-- SNI (Server Name Indication)
+getServerName :: [ExtensionRaw] -> Maybe HostName
+getServerName chExts =
+    lookupAndDecode
+        EID_ServerName
+        MsgTClientHello
+        chExts
+        Nothing
+        extractServerName
+  where
+    extractServerName (ServerName ns) = listToMaybe (mapMaybe toHostName ns)
+    toHostName (ServerNameHostName hostName) = Just hostName
+    toHostName (ServerNameOther _) = Nothing
+
+findHighestVersionFrom :: Version -> [Version] -> Maybe Version
+findHighestVersionFrom clientVersion allowedVersions =
+    case filter (clientVersion >=) $ sortOn Down allowedVersions of
+        [] -> Nothing
+        v : _ -> Just v
+
+findHighestVersionFrom13 :: [Version] -> [Version] -> Maybe Version
+findHighestVersionFrom13 clientVersions serverVersions = case svs `intersect` cvs of
+    [] -> Nothing
+    v : _ -> Just v
+  where
+    svs = sortOn Down serverVersions
+    cvs = sortOn Down $ filter (>= TLS12) clientVersions
+
+decryptECH
+    :: ServerParams
+    -> Context
+    -> ClientHello
+    -> EncryptedClientHello
+    -> IO (Maybe ClientHello)
+decryptECH _ _ _ ECHClientHelloInner = return Nothing
+decryptECH sparams ctx chO ech@ECHClientHelloOuter{..} = E.handle hpkeHandler $ do
+    mfunc <- getHPKE sparams ctx ech
+    case mfunc of
+        Nothing -> return Nothing
+        Just (func, nenc) -> do
+            hrr <- usingState_ ctx getTLS13HRR
+            let nenc' = if hrr then 0 else nenc
+            let aad = encodeHandshake' $ ClientHello $ fill0ClientHello nenc' chO
+            plaintext <- func aad echPayload
+            case decodeClientHello' plaintext of
+                Right (ClientHello chI) -> do
+                    case expandClientHello chI chO of
+                        Nothing -> return Nothing
+                        Just chI' -> return $ Just chI'
+                _ -> return Nothing
+  where
+    hpkeHandler :: HPKEError -> IO (Maybe ClientHello)
+    hpkeHandler _ = return Nothing
+decryptECH _ _ _ _ = return Nothing
+
+fill0ClientHello :: Int -> ClientHello -> ClientHello
+fill0ClientHello nenc ch@CH{..} =
+    ch{chExtensions = fill0Exts nenc chExtensions}
+
+fill0Exts :: Int -> [ExtensionRaw] -> [ExtensionRaw]
+fill0Exts nenc xs0 = loop xs0
+  where
+    loop [] = []
+    loop (ExtensionRaw EID_EncryptedClientHello bs : xs) = x' : loop xs
+      where
+        (prefix, payload) = BS.splitAt (10 + nenc) bs
+        bs' = prefix <> BS.replicate (BS.length payload) 0
+        x' = ExtensionRaw EID_EncryptedClientHello bs'
+    loop (x : xs) = x : loop xs
+
+expandClientHello :: ClientHello -> ClientHello -> Maybe ClientHello
+expandClientHello inner outer =
+    case expand (chExtensions inner) (chExtensions outer) of
+        Nothing -> Nothing
+        Just exts ->
+            Just $
+                inner
+                    { chSession = chSession outer
+                    , chExtensions = exts
+                    }
+  where
+    expand :: [ExtensionRaw] -> [ExtensionRaw] -> Maybe [ExtensionRaw]
+    expand [] _ = Just []
+    expand iis [] = chk iis
+    expand (i : is) oos = do
+        (rs, oos') <- case i of
+            ExtensionRaw EID_EchOuterExtensions bs ->
+                case extensionDecode MsgTClientHello bs of
+                    Nothing -> Nothing
+                    Just (EchOuterExtensions eids) -> expd eids oos
+            _ -> Just ([i], oos)
+        (rs ++) <$> expand is oos'
+    expd
+        :: [ExtensionID] -> [ExtensionRaw] -> Maybe ([ExtensionRaw], [ExtensionRaw])
+    expd [] oos = Just ([], oos)
+    expd _ [] = Nothing
+    expd (i : is) oos = case fnd i oos of
+        Nothing -> Nothing
+        Just (ext, oos') -> do
+            (exts, oos'') <- expd is oos'
+            Just (ext : exts, oos'')
+    fnd :: ExtensionID -> [ExtensionRaw] -> Maybe (ExtensionRaw, [ExtensionRaw])
+    fnd _ [] = Nothing
+    fnd EID_EncryptedClientHello _ = Nothing
+    fnd i (o@(ExtensionRaw eid _) : os)
+        | i == eid = Just (o, os)
+        | otherwise = fnd i os
+    chk :: [ExtensionRaw] -> Maybe [ExtensionRaw]
+    chk [] = Just []
+    chk (ExtensionRaw EID_EchOuterExtensions _ : _) = Nothing
+    chk (i : is) = (i :) <$> chk is
+
+getHPKE
+    :: ServerParams
+    -> Context
+    -> EncryptedClientHello
+    -> IO (Maybe (HPKEF, Int))
+getHPKE ServerParams{..} ctx ECHClientHelloOuter{..} = do
+    mfunc <- getTLS13HPKE ctx
+    case mfunc of
+        Nothing -> do
+            let mconfig = findECHConfigById echConfigId $ sharedECHConfigList serverShared
+                mskR = lookup echConfigId serverECHKey
+            case (mconfig, mskR) of
+                (Just config, Just skR') -> do
+                    let kemid = KEM_ID $ kem_id $ key_config $ contents config
+                        skR = EncodedSecretKey skR'
+                        encodedConfig = encodeECHConfig config
+                    let info = "tls ech\x00" <> encodedConfig
+                        (kdfid, aeadid) = echCipherSuite
+                    ctxR <- setupBaseR kemid kdfid aeadid skR Nothing echEnc info
+                    let nenc = nEnc kemid
+                        func = open ctxR
+                    setTLS13HPKE ctx func nenc
+                    return $ Just (func, nenc)
+                _ -> return Nothing
+        _ -> return mfunc
+getHPKE _ _ _ = return Nothing
+
+findECHConfigById :: ConfigId -> ECHConfigList -> Maybe ECHConfig
+findECHConfigById cnfId echConfigList = find eqCfgId echConfigList
+  where
+    eqCfgId cnf = config_id (key_config (contents cnf)) == cnfId
diff --git a/Network/TLS/Handshake/Server/ClientHello12.hs b/Network/TLS/Handshake/Server/ClientHello12.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/ClientHello12.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Server.ClientHello12 (
+    processClientHello12,
+) where
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Credentials
+import Network.TLS.Crypto
+import Network.TLS.ErrT
+import Network.TLS.Extension
+import Network.TLS.Handshake.Server.Common
+import Network.TLS.Handshake.Signature
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Types (CipherId (..), Role (..))
+
+----------------------------------------------------------------
+
+-- serverSupported sparams == ctxSupported ctx
+
+-- TLS 1.2 or earlier
+processClientHello12
+    :: ServerParams
+    -> Context
+    -> ClientHello
+    -> IO (Cipher, Maybe Credential)
+processClientHello12 sparams ctx ch = do
+    let secureRenegotiation = supportedSecureRenegotiation $ serverSupported sparams
+    when secureRenegotiation $ checkSecureRenegotiation ctx ch
+    serverName <- usingState_ ctx getClientSNI
+    let hooks = serverHooks sparams
+    extraCreds <- onServerNameIndication hooks serverName
+    let (creds, signatureCreds, ciphersFilteredVersion) =
+            credsTriple sparams ch extraCreds
+    -- The shared cipherlist can become empty after filtering for compatible
+    -- creds, check now before calling onCipherChoosing, which does not handle
+    -- empty lists.
+    when (null ciphersFilteredVersion) $
+        throwCore $
+            Error_Protocol "no cipher in common with the TLS 1.2 client" HandshakeFailure
+    let usedCipher = onCipherChoosing hooks TLS12 ciphersFilteredVersion
+    mcred <- chooseCreds usedCipher creds signatureCreds
+    return (usedCipher, mcred)
+
+checkSecureRenegotiation :: Context -> ClientHello -> IO ()
+checkSecureRenegotiation ctx CH{..} = do
+    -- RFC 5746: secure renegotiation
+    -- TLS_EMPTY_RENEGOTIATION_INFO_SCSV: {0x00, 0xFF}
+    when (CipherId 0xff `elem` chCiphers) $
+        usingState_ ctx $
+            setSecureRenegotiation True
+    case extensionLookup EID_SecureRenegotiation chExtensions of
+        Just content -> usingState_ ctx $ do
+            VerifyData cvd <- getVerifyData ClientRole
+            let bs = extensionEncode (SecureRenegotiation cvd "")
+            unless (bs == content) $
+                throwError $
+                    Error_Protocol
+                        ("client verified data not matching: " ++ show cvd ++ ":" ++ show content)
+                        HandshakeFailure
+
+            setSecureRenegotiation True
+        _ -> return ()
+
+----------------------------------------------------------------
+
+credsTriple
+    :: ServerParams
+    -> ClientHello
+    -> Credentials
+    -> (Credentials, Credentials, [Cipher])
+credsTriple sparams CH{..} extraCreds
+    | cipherListCredentialFallback cltCiphers = (allCreds, sigAllCreds, allCiphers)
+    | otherwise = (cltCreds, sigCltCreds, cltCiphers)
+  where
+    ciphers = supportedCiphers $ serverSupported sparams
+
+    commonCiphers creds sigCreds = intersectCiphers chCiphers availableCiphers
+      where
+        availableCiphers = getCiphers ciphers creds sigCreds
+
+    p = makeCredentialPredicate TLS12 chExtensions
+    allCreds =
+        filterCredentials (isCredentialAllowed TLS12 p) $
+            extraCreds `mappend` sharedCredentials (serverShared sparams)
+
+    -- When selecting a cipher we must ensure that it is allowed for the
+    -- TLS version but also that all its key-exchange requirements
+    -- will be met.
+
+    -- Some ciphers require a signature and a hash.  With TLS 1.2 the hash
+    -- algorithm is selected from a combination of server configuration and
+    -- the client "supported_signatures" extension.  So we cannot pick
+    -- such a cipher if no hash is available for it.  It's best to skip this
+    -- cipher and pick another one (with another key exchange).
+
+    -- Cipher selection is performed in two steps: first server credentials
+    -- are flagged as not suitable for signature if not compatible with
+    -- negotiated signature parameters.  Then ciphers are evaluated from
+    -- the resulting credentials.
+
+    supported = serverSupported sparams
+    groups = supportedGroups supported
+    possibleGroups = negotiatedGroupsInCommon groups chExtensions
+    possibleECGroups = possibleGroups `intersect` availableECGroups
+    possibleFFGroups = possibleGroups `intersect` availableFFGroups
+    hasCommonGroupForECDHE = not (null possibleECGroups)
+    hasCommonGroupForFFDHE = not (null possibleFFGroups)
+    hasCustomGroupForFFDHE = isJust (serverDHEParams sparams)
+    canFFDHE = hasCustomGroupForFFDHE || hasCommonGroupForFFDHE
+    hasCommonGroup cipher =
+        case cipherKeyExchange cipher of
+            CipherKeyExchange_DH_Anon -> canFFDHE
+            CipherKeyExchange_DHE_RSA -> canFFDHE
+            CipherKeyExchange_DHE_DSA -> canFFDHE
+            CipherKeyExchange_ECDHE_RSA -> hasCommonGroupForECDHE
+            CipherKeyExchange_ECDHE_ECDSA -> hasCommonGroupForECDHE
+            _ -> True -- group not used
+
+    -- Ciphers are selected according to TLS version, availability of
+    -- (EC)DHE group and credential depending on key exchange.
+    cipherAllowed cipher = cipherAllowedForVersion TLS12 cipher && hasCommonGroup cipher
+    selectCipher credentials signatureCredentials = filter cipherAllowed (commonCiphers credentials signatureCredentials)
+
+    -- Build a list of all hash/signature algorithms in common between
+    -- client and server.
+    hashAndSignatures = supportedHashSignatures supported
+    possibleHashSigAlgs = hashAndSignaturesInCommon hashAndSignatures chExtensions
+
+    -- Check that a candidate signature credential will be compatible with
+    -- client & server hash/signature algorithms.  This returns Just Int
+    -- in order to sort credentials according to server hash/signature
+    -- preference.  When the certificate has no matching hash/signature in
+    -- 'possibleHashSigAlgs' the result is Nothing, and the credential will
+    -- not be used to sign.  This avoids a failure later in 'decideHashSig'.
+    signingRank cred =
+        case credentialDigitalSignatureKey cred of
+            Just pub -> findIndex (pub `signatureCompatible`) possibleHashSigAlgs
+            Nothing -> Nothing
+
+    -- Finally compute credential lists and resulting cipher list.
+    --
+    -- We try to keep certificates supported by the client, but
+    -- fallback to all credentials if this produces no suitable result
+    -- (see RFC 5246 section 7.4.2 and RFC 8446 section 4.4.2.2).
+    -- The condition is based on resulting (EC)DHE ciphers so that
+    -- filtering credentials does not give advantage to a less secure
+    -- key exchange like CipherKeyExchange_RSA or CipherKeyExchange_DH_Anon.
+    cltCreds = filterCredentialsWithHashSignatures chExtensions allCreds
+    sigCltCreds = filterSortCredentials signingRank cltCreds
+    sigAllCreds = filterSortCredentials signingRank allCreds
+    cltCiphers = selectCipher cltCreds sigCltCreds
+    allCiphers = selectCipher allCreds sigAllCreds
+
+chooseCreds :: Cipher -> Credentials -> Credentials -> IO (Maybe Credential)
+chooseCreds usedCipher creds signatureCreds = case cipherKeyExchange usedCipher of
+    CipherKeyExchange_RSA -> return $ credentialsFindForDecrypting creds
+    CipherKeyExchange_DH_Anon -> return Nothing
+    CipherKeyExchange_DHE_RSA -> return $ credentialsFindForSigning KX_RSA signatureCreds
+    CipherKeyExchange_DHE_DSA -> return $ credentialsFindForSigning KX_DSA signatureCreds
+    CipherKeyExchange_ECDHE_RSA -> return $ credentialsFindForSigning KX_RSA signatureCreds
+    CipherKeyExchange_ECDHE_ECDSA -> return $ credentialsFindForSigning KX_ECDSA signatureCreds
+    _ ->
+        throwCore $
+            Error_Protocol "key exchange algorithm not implemented" HandshakeFailure
+
+----------------------------------------------------------------
+
+negotiatedGroupsInCommon :: [Group] -> [ExtensionRaw] -> [Group]
+negotiatedGroupsInCommon serverGroups exts =
+    lookupAndDecode
+        EID_SupportedGroups
+        MsgTClientHello
+        exts
+        []
+        (\(SupportedGroups clientGroups) -> serverGroups `intersect` clientGroups)
+
+----------------------------------------------------------------
+
+filterSortCredentials
+    :: Ord a => (Credential -> Maybe a) -> Credentials -> Credentials
+filterSortCredentials rankFun (Credentials creds) =
+    let orderedPairs = sortOn fst [(rankFun cred, cred) | cred <- creds]
+     in Credentials [cred | (Just _, cred) <- orderedPairs]
+
+-- returns True if certificate filtering with "signature_algorithms_cert" /
+-- "signature_algorithms" produced no ephemeral D-H nor TLS13 cipher (so
+-- handshake with lower security)
+cipherListCredentialFallback :: [Cipher] -> Bool
+cipherListCredentialFallback = all nonDH
+  where
+    nonDH x = case cipherKeyExchange x of
+        CipherKeyExchange_DHE_RSA -> False
+        CipherKeyExchange_DHE_DSA -> False
+        CipherKeyExchange_ECDHE_RSA -> False
+        CipherKeyExchange_ECDHE_ECDSA -> False
+        CipherKeyExchange_TLS13 -> False
+        _ -> True
+
+-- We filter our allowed ciphers here according to dynamic credential lists.
+-- Credentials 'creds' come from server parameters but also SNI callback.
+-- When the key exchange requires a signature, we use a
+-- subset of this list named 'sigCreds'.  This list has been filtered in order
+-- to remove certificates that are not compatible with hash/signature
+-- restrictions (TLS 1.2).
+getCiphers :: [Cipher] -> Credentials -> Credentials -> [Cipher]
+getCiphers ciphers creds sigCreds = filter authorizedCKE ciphers
+  where
+    authorizedCKE cipher =
+        case cipherKeyExchange cipher of
+            CipherKeyExchange_RSA -> canEncryptRSA
+            CipherKeyExchange_DH_Anon -> True
+            CipherKeyExchange_DHE_RSA -> canSignRSA
+            CipherKeyExchange_DHE_DSA -> canSignDSA
+            CipherKeyExchange_ECDHE_RSA -> canSignRSA
+            CipherKeyExchange_ECDHE_ECDSA -> canSignECDSA
+            -- unimplemented: non ephemeral DH & ECDH.
+            -- Note, these *should not* be implemented, and have
+            -- (for example) been removed in OpenSSL 1.1.0
+            --
+            CipherKeyExchange_DH_DSA -> False
+            CipherKeyExchange_DH_RSA -> False
+            CipherKeyExchange_ECDH_ECDSA -> False
+            CipherKeyExchange_ECDH_RSA -> False
+            CipherKeyExchange_TLS13 -> False -- not reached
+    canSignDSA = KX_DSA `elem` signingAlgs
+    canSignRSA = KX_RSA `elem` signingAlgs
+    canSignECDSA = KX_ECDSA `elem` signingAlgs
+    canEncryptRSA = isJust $ credentialsFindForDecrypting creds
+    signingAlgs = credentialsListSigningAlgorithms sigCreds
diff --git a/Network/TLS/Handshake/Server/ClientHello13.hs b/Network/TLS/Handshake/Server/ClientHello13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/ClientHello13.hs
@@ -0,0 +1,212 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Server.ClientHello13 (
+    processClientHello13,
+    SelectKeyShareResult (..),
+) where
+
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.IO.Encode
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.Session
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Types
+
+limitSupportedGroups :: Int
+limitSupportedGroups = 64
+
+-- TLS 1.3 or later
+processClientHello13
+    :: ServerParams
+    -> Context
+    -> ClientHello
+    -> IO
+        ( SelectKeyShareResult
+        , (Cipher, Hash, Bool) -- rtt0
+        , (SecretPair EarlySecret, [ExtensionRaw], Bool, Bool) -- authenticated, is0RTTvalid
+        )
+processClientHello13 sparams ctx ch@CH{..} = do
+    when
+        (any (\(ExtensionRaw eid _) -> eid == EID_PreSharedKey) $ init chExtensions)
+        $ throwCore
+        $ Error_Protocol "extension pre_shared_key must be last" IllegalParameter
+    -- Deciding cipher.
+    -- The shared cipherlist can become empty after filtering for compatible
+    -- creds, check now before calling onCipherChoosing, which does not handle
+    -- empty lists.
+    when (null ciphersFilteredVersion) $
+        throwCore $
+            Error_Protocol "no cipher in common with the TLS 1.3 client" HandshakeFailure
+    let usedCipher = onCipherChoosing (serverHooks sparams) TLS13 ciphersFilteredVersion
+        usedHash = cipherHash usedCipher
+        rtt0 =
+            lookupAndDecode
+                EID_EarlyData
+                MsgTClientHello
+                chExtensions
+                False
+                (\(EarlyDataIndication _) -> True)
+    if rtt0
+        then
+            -- mark a 0-RTT attempt before a possible HRR, and before updating the
+            -- status again if 0-RTT successful
+            setEstablished ctx (EarlyDataNotAllowed 3) -- hardcoding
+        else
+            -- In the case of HRR, EarlyDataNotAllowed is already set.
+            -- It should be cleared here.
+            setEstablished ctx NotEstablished
+    -- Deciding key exchange from key shares
+    let require =
+            throwCore $
+                Error_Protocol
+                    "key exchange not implemented, expected key_share extension"
+                    MissingExtension
+        extract (KeyShareClientHello kses) = return kses
+        extract _ = require
+    keyShares <-
+        lookupAndDecodeAndDo EID_KeyShare MsgTClientHello chExtensions require extract
+    let clientGroups =
+            take limitSupportedGroups $
+                lookupAndDecode
+                    EID_SupportedGroups
+                    MsgTClientHello
+                    chExtensions
+                    []
+                    (\(SupportedGroups gs) -> gs)
+    (mgroup, doHRR) <-
+        onSelectKeyShare
+            (serverHooks sparams)
+            serverGroups
+            clientGroups
+            $ map keyShareEntryGroup keyShares
+    keyshareResult <- case mgroup of
+        Nothing -> return SelectKeyShareNotFound
+        Just g
+            | doHRR -> return $ SelectKeyShareHRR g
+            | otherwise -> case filter (\e -> keyShareEntryGroup e == g) keyShares of
+                [] -> return SelectKeyShareNotFound
+                [x] -> return $ SelectKeyShareFound x
+                _ -> throwCore $ Error_Protocol "duplicated key_share" IllegalParameter
+
+    let triple = (usedCipher, usedHash, rtt0)
+    pskEarlySecret <- pskAndEarlySecret sparams ctx triple ch
+    (ich, b) <- fromJust <$> usingHState ctx getClientHello
+    updateTranscriptHash12 ctx (ClientHello ich, b)
+    return (keyshareResult, triple, pskEarlySecret)
+  where
+    ciphersFilteredVersion = intersectCiphers chCiphers serverCiphers
+    serverCiphers =
+        filter
+            (cipherAllowedForVersion TLS13)
+            (supportedCiphers $ serverSupported sparams)
+    serverGroups = supportedGroupsTLS13 $ serverSupported sparams
+
+data SelectKeyShareResult
+    = -- | Negotiation failure
+      SelectKeyShareNotFound
+    | -- | Send a hello retry request with this group
+      SelectKeyShareHRR Group
+    | -- | Use this key share
+      SelectKeyShareFound KeyShareEntry
+    deriving (Eq, Show)
+
+pskAndEarlySecret
+    :: ServerParams
+    -> Context
+    -> (Cipher, Hash, Bool) -- rtt0
+    -> ClientHello
+    -> IO (SecretPair EarlySecret, [ExtensionRaw], Bool, Bool) -- authenticated, is0RTTvalid
+pskAndEarlySecret sparams ctx (usedCipher, usedHash, rtt0) CH{..} = do
+    (psk, binderInfo, is0RTTvalid) <- choosePSK
+    earlyKey <- calculateEarlySecret ctx choice (Left psk)
+    let earlySecret = pairBase earlyKey
+        authenticated = isJust binderInfo
+    preSharedKeyExt <- checkBinder earlySecret binderInfo
+    return (earlyKey, preSharedKeyExt, authenticated, is0RTTvalid)
+  where
+    choice = makeCipherChoice TLS13 usedCipher
+
+    choosePSK =
+        lookupAndDecodeAndDo
+            EID_PreSharedKey
+            MsgTClientHello
+            chExtensions
+            (return (zero, Nothing, False))
+            selectPSK
+
+    selectPSK (PreSharedKeyClientHello (PskIdentity identity obfAge : _) bnds@(bnd : _)) = do
+        when (null dhModes) $
+            throwCore $
+                Error_Protocol "no psk_key_exchange_modes extension" MissingExtension
+        if PSK_DHE_KE `elem` dhModes
+            then do
+                let len = sum (map (\x -> B.length x + 1) bnds) + 2
+                    mgr = sharedSessionManager $ serverShared sparams
+                -- sessionInvalidate is not used for TLS 1.3
+                -- because PSK is always changed.
+                -- So, identity is not stored in Context.
+                msdata <-
+                    if rtt0
+                        then sessionResumeOnlyOnce mgr identity
+                        else sessionResume mgr identity
+                case msdata of
+                    Just sdata -> do
+                        let tinfo = fromJust $ sessionTicketInfo sdata
+                            psk = sessionSecret sdata
+                        isFresh <- checkFreshness tinfo obfAge
+                        (isPSKvalid, is0RTTvalid) <- checkSessionEquality sdata
+                        if isPSKvalid && isFresh
+                            then return (psk, Just (bnd, 0 :: Int, len), is0RTTvalid)
+                            else -- fall back to full handshake
+                                return (zero, Nothing, False)
+                    _ -> return (zero, Nothing, False)
+            else return (zero, Nothing, False)
+    selectPSK _ = return (zero, Nothing, False)
+
+    checkBinder _ Nothing = return []
+    checkBinder earlySecret (Just (binder, n, tlen)) = do
+        (_, b) <- fromJust <$> usingHState ctx getClientHello
+        let binder' = makePSKBinder earlySecret usedHash tlen $ B.concat b --- xxx
+        unless (binder == binder') $
+            decryptError "PSK binder validation failed"
+        return [toExtensionRaw $ PreSharedKeyServerHello $ fromIntegral n]
+
+    checkSessionEquality sdata = do
+        msni <- usingState_ ctx getClientSNI
+        -- ALPN should be checked.
+        -- But it's an extension in EE, sigh.
+        --        malpn <- usingState_ ctx getNegotiatedProtocol
+        let isSameSNI = sessionClientSNI sdata == msni
+            isSameCipher = sessionCipher sdata == cipherID usedCipher
+            ciphers = supportedCiphers $ serverSupported sparams
+            scid = sessionCipher sdata
+            isSameKDF = case findCipher scid ciphers of
+                Nothing -> False
+                Just c -> cipherHash c == cipherHash usedCipher
+            isSameVersion = TLS13 == sessionVersion sdata
+            --            isSameALPN = sessionALPN sdata == malpn
+            isPSKvalid = isSameKDF && isSameSNI -- fixme: SNI is not required
+            is0RTTvalid = isSameVersion && isSameCipher -- && isSameALPN
+        return (isPSKvalid, is0RTTvalid)
+
+    dhModes =
+        lookupAndDecode
+            EID_PskKeyExchangeModes
+            MsgTClientHello
+            chExtensions
+            []
+            (\(PskKeyExchangeModes ms) -> ms)
+
+    hashSize = hashDigestSize usedHash
+    zero = B.replicate hashSize 0
diff --git a/Network/TLS/Handshake/Server/Common.hs b/Network/TLS/Handshake/Server/Common.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/Common.hs
@@ -0,0 +1,207 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.Server.Common (
+    applicationProtocol,
+    checkValidClientCertChain,
+    clientCertificate,
+    credentialDigitalSignatureKey,
+    filterCredentials,
+    filterCredentialsWithHashSignatures,
+    makeCredentialPredicate,
+    isCredentialAllowed,
+    storePrivInfoServer,
+    hashAndSignaturesInCommon,
+    processRecordSizeLimit,
+) where
+
+import Control.Monad.State.Strict
+import Data.X509 (ExtKeyUsageFlag (..), ExtKeyUsagePurpose (..))
+
+import Network.TLS.Context.Internal
+import Network.TLS.Credentials
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Certificate
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Util (catchException)
+import Network.TLS.X509
+
+checkValidClientCertChain
+    :: MonadIO m => Context -> String -> m CertificateChain
+checkValidClientCertChain ctx errmsg = do
+    chain <- usingHState ctx getClientCertChain
+    let throwerror = Error_Protocol errmsg UnexpectedMessage
+    case chain of
+        Nothing -> throwCore throwerror
+        Just cc
+            | isNullCertificateChain cc -> throwCore throwerror
+            | otherwise -> return cc
+
+credentialDigitalSignatureKey :: Credential -> Maybe PubKey
+credentialDigitalSignatureKey cred
+    | isDigitalSignaturePair keys = Just pubkey
+    | otherwise = Nothing
+  where
+    keys@(pubkey, _) = credentialPublicPrivateKeys cred
+
+filterCredentials :: (Credential -> Bool) -> Credentials -> Credentials
+filterCredentials p (Credentials l) = Credentials (filter p l)
+
+-- ECDSA keys are tested against supported elliptic curves until TLS12 but
+-- not after.  With TLS13, the curve is linked to the signature algorithm
+-- and client support is tested with signatureCompatible13.
+makeCredentialPredicate :: Version -> [ExtensionRaw] -> (Group -> Bool)
+makeCredentialPredicate ver exts
+    | ver >= TLS13 = const True
+    | otherwise =
+        lookupAndDecode
+            EID_SupportedGroups
+            MsgTClientHello
+            exts
+            (const True)
+            (\(SupportedGroups sg) -> (`elem` sg))
+
+isCredentialAllowed :: Version -> (Group -> Bool) -> Credential -> Bool
+isCredentialAllowed ver p cred =
+    pubkey `versionCompatible` ver && satisfiesEcPredicate p pubkey
+  where
+    (pubkey, _) = credentialPublicPrivateKeys cred
+
+-- Filters a list of candidate credentials with credentialMatchesHashSignatures.
+--
+-- Algorithms to filter with are taken from "signature_algorithms_cert"
+-- extension when it exists, else from "signature_algorithms" when clients do
+-- not implement the new extension (see RFC 8446 section 4.2.3).
+--
+-- Resulting credential list can be used as input to the hybrid cipher-and-
+-- certificate selection for TLS12, or to the direct certificate selection
+-- simplified with TLS13.  As filtering credential signatures with client-
+-- advertised algorithms is not supposed to cause negotiation failure, in case
+-- of dead end with the subsequent selection process, this process should always
+-- be restarted with the unfiltered credential list as input (see fallback
+-- certificate chains, described in same RFC section).
+--
+-- Calling code should not forget to apply constraints of extension
+-- "signature_algorithms" to any signature-based key exchange derived from the
+-- output credentials.  Respecting client constraints on KX signatures is
+-- mandatory but not implemented by this function.
+filterCredentialsWithHashSignatures
+    :: [ExtensionRaw] -> Credentials -> Credentials
+filterCredentialsWithHashSignatures exts =
+    lookupAndDecode
+        EID_SignatureAlgorithmsCert
+        MsgTClientHello
+        exts
+        lookupSignatureAlgorithms
+        (\(SignatureAlgorithmsCert sas) -> withAlgs sas)
+  where
+    lookupSignatureAlgorithms =
+        lookupAndDecode
+            EID_SignatureAlgorithms
+            MsgTClientHello
+            exts
+            id
+            (\(SignatureAlgorithms sas) -> withAlgs sas)
+    withAlgs sas = filterCredentials (credentialMatchesHashSignatures sas)
+
+storePrivInfoServer :: MonadIO m => Context -> Credential -> m ()
+storePrivInfoServer ctx (cc, privkey) = void (storePrivInfo ctx cc privkey)
+
+-- ALPN (Application Layer Protocol Negotiation)
+applicationProtocol
+    :: Context -> [ExtensionRaw] -> ServerParams -> IO (Maybe ExtensionRaw)
+applicationProtocol ctx exts sparams = case onALPN of
+    Nothing -> return Nothing
+    Just io ->
+        lookupAndDecodeAndDo
+            EID_ApplicationLayerProtocolNegotiation
+            MsgTClientHello
+            exts
+            (return Nothing)
+            $ select io
+  where
+    onALPN = onALPNClientSuggest $ serverHooks sparams
+    select io (ApplicationLayerProtocolNegotiation protos) = do
+        proto <- io protos
+        when (proto == "") $
+            throwCore $
+                Error_Protocol "no supported application protocols" NoApplicationProtocol
+        usingState_ ctx $ do
+            setExtensionALPN True
+            setNegotiatedProtocol proto
+        let alpn = ApplicationLayerProtocolNegotiation [proto]
+        return $ Just $ toExtensionRaw alpn
+
+clientCertificate :: ServerParams -> Context -> CertificateChain -> IO ()
+clientCertificate sparams ctx certs = do
+    -- run certificate recv hook
+    ctxWithHooks ctx (`hookRecvCertificates` certs)
+    -- Call application callback to see whether the
+    -- certificate chain is acceptable.
+    --
+    usage <-
+        liftIO $
+            catchException
+                (onClientCertificate (serverHooks sparams) certs)
+                rejectOnException
+    case usage of
+        CertificateUsageAccept -> do
+            verifyLeafKeyUsage [KeyUsage_digitalSignature] certs
+            verifyLeafKeyUsagePurpose KeyUsagePurpose_ClientAuth certs
+        CertificateUsageReject reason -> certificateRejected reason
+
+    -- Remember cert chain for later use.
+    --
+    usingHState ctx $ setClientCertChain certs
+
+----------------------------------------------------------------
+
+-- The values in the "signature_algorithms" extension
+-- are in descending order of preference.
+-- However here the algorithms are selected according
+-- to server preference in 'supportedHashSignatures'.
+hashAndSignaturesInCommon
+    :: [HashAndSignatureAlgorithm] -> [ExtensionRaw] -> [HashAndSignatureAlgorithm]
+hashAndSignaturesInCommon sHashSigs exts = sHashSigs `intersect` cHashSigs
+  where
+    -- See Section 7.4.1.4.1 of RFC 5246.
+    defVal =
+        [ (HashSHA1, SignatureECDSA)
+        , (HashSHA1, SignatureRSA)
+        , (HashSHA1, SignatureDSA)
+        ]
+    cHashSigs =
+        lookupAndDecode
+            EID_SignatureAlgorithms
+            MsgTClientHello
+            exts
+            defVal
+            (\(SignatureAlgorithms sas) -> sas)
+
+processRecordSizeLimit
+    :: Context -> [ExtensionRaw] -> Bool -> IO (Maybe ExtensionRaw)
+processRecordSizeLimit ctx chExts tls13 = do
+    let mmylim = limitRecordSize $ sharedLimit $ ctxShared ctx
+    setMyRecordLimit ctx mmylim
+    case mmylim of
+        Nothing -> return Nothing
+        Just mylim -> do
+            lookupAndDecodeAndDo
+                EID_RecordSizeLimit
+                MsgTClientHello
+                chExts
+                (return ())
+                (setPeerRecordSizeLimit ctx tls13)
+            peerSentRSL <- checkPeerRecordLimit ctx
+            if peerSentRSL
+                then do
+                    let mysiz = fromIntegral mylim + if tls13 then 1 else 0
+                        rsl = RecordSizeLimit mysiz
+                    return $ Just $ toExtensionRaw rsl
+                else return Nothing
diff --git a/Network/TLS/Handshake/Server/ServerHello12.hs b/Network/TLS/Handshake/Server/ServerHello12.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/ServerHello12.hs
@@ -0,0 +1,325 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Server.ServerHello12 (
+    sendServerHello12,
+) where
+
+import Data.ByteArray (convert)
+
+import Network.TLS.Cipher
+import Network.TLS.Compression
+import Network.TLS.Context.Internal
+import Network.TLS.Credentials
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Certificate
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Random
+import Network.TLS.Handshake.Server.Common
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.Session
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Types
+import Network.TLS.X509 hiding (Certificate)
+
+sendServerHello12
+    :: ServerParams
+    -> Context
+    -> (Cipher, Maybe Credential)
+    -> ClientHello
+    -> IO (Maybe SessionData)
+sendServerHello12 sparams ctx (usedCipher, mcred) ch@CH{..} = do
+    resumeSessionData <- recoverSessionData ctx ch
+    case resumeSessionData of
+        Nothing -> do
+            serverSession <- newSession ctx
+            usingState_ ctx $ setSession serverSession
+            sh <- makeServerHello sparams ctx usedCipher mcred chExtensions serverSession
+            build <- sendServerFirstFlight sparams ctx usedCipher mcred chExtensions
+            let ff = ServerHello sh : build [ServerHelloDone]
+            sendPacket12 ctx $ Handshake ff []
+            contextFlush ctx
+        Just sessionData -> do
+            usingState_ ctx $ do
+                setSession chSession
+                setTLS12SessionResuming True
+            sh <-
+                makeServerHello sparams ctx usedCipher mcred chExtensions chSession
+            sendPacket12 ctx $ Handshake [ServerHello sh] []
+            let mainSecret = convert $ sessionSecret sessionData
+            usingHState ctx $ setMainSecret TLS12 ServerRole mainSecret
+            logKey ctx $ MainSecret mainSecret
+            sendCCSandFinished ctx ServerRole
+    return resumeSessionData
+
+recoverSessionData :: Context -> ClientHello -> IO (Maybe SessionData)
+recoverSessionData ctx CH{..} = do
+    serverName <- usingState_ ctx getClientSNI
+    ems <- processExtendedMainSecret ctx TLS12 MsgTClientHello chExtensions
+    let mticket =
+            lookupAndDecode
+                EID_SessionTicket
+                MsgTClientHello
+                chExtensions
+                Nothing
+                (\(SessionTicket ticket) -> Just ticket)
+        midentity = ticketOrSessionID12 mticket chSession
+    case midentity of
+        Nothing -> return Nothing
+        Just identity -> do
+            sd <- sessionResume (sharedSessionManager $ ctxShared ctx) identity
+            validateSession ctx chCiphers serverName ems sd
+
+validateSession
+    :: Context
+    -> [CipherId]
+    -> Maybe HostName
+    -> Bool
+    -> Maybe SessionData
+    -> IO (Maybe SessionData)
+validateSession _ _ _ _ Nothing = return Nothing
+validateSession ctx ciphers sni ems m@(Just sd)
+    -- SessionData parameters are assumed to match the local server configuration
+    -- so we need to compare only to ClientHello inputs.  Abbreviated handshake
+    -- uses the same server_name than full handshake so the same
+    -- credentials (and thus ciphers) are available.
+    | TLS12 < sessionVersion sd = return Nothing -- fixme
+    | CipherId (sessionCipher sd) `notElem` ciphers =
+        throwCore $
+            Error_Protocol "new cipher is different from the old one" IllegalParameter
+    | isJust sni && sessionClientSNI sd /= sni = do
+        usingState_ ctx clearClientSNI
+        return Nothing
+    | ems && not emsSession = return Nothing
+    | not ems && emsSession =
+        let err = "client resumes an EMS session without EMS"
+         in throwCore $ Error_Protocol err HandshakeFailure
+    | otherwise = return m
+  where
+    emsSession = SessionEMS `elem` sessionFlags sd
+
+sendServerFirstFlight
+    :: ServerParams
+    -> Context
+    -> Cipher
+    -> Maybe Credential
+    -> [ExtensionRaw]
+    -> IO ([Handshake] -> [Handshake])
+sendServerFirstFlight ServerParams{..} ctx usedCipher mcred chExts = do
+    let b0 = id
+    let cc = case mcred of
+            Just (srvCerts, _) -> srvCerts
+            _ -> CertificateChain []
+    let b1 = b0 . (Certificate (CertificateChain_ cc) :)
+    usingState_ ctx $ setServerCertificateChain cc
+
+    -- send server key exchange if needed
+    skx <- case cipherKeyExchange usedCipher of
+        CipherKeyExchange_DH_Anon -> Just <$> generateSKX_DH_Anon
+        CipherKeyExchange_DHE_RSA -> Just <$> generateSKX_DHE KX_RSA
+        CipherKeyExchange_DHE_DSA -> Just <$> generateSKX_DHE KX_DSA
+        CipherKeyExchange_ECDHE_RSA -> Just <$> generateSKX_ECDHE KX_RSA
+        CipherKeyExchange_ECDHE_ECDSA -> Just <$> generateSKX_ECDHE KX_ECDSA
+        _ -> return Nothing
+    let b2 = case skx of
+            Nothing -> b1
+            Just kx -> b1 . (ServerKeyXchg kx :)
+
+    -- FIXME we don't do this on a Anonymous server
+
+    -- When configured, send a certificate request with the DNs of all
+    -- configured CA certificates.
+    --
+    -- Client certificates MUST NOT be accepted if not requested.
+    --
+    if serverWantClientCert
+        then do
+            let (certTypes, hashSigs) =
+                    let as = supportedHashSignatures serverSupported
+                     in (nub $ mapMaybe hashSigToCertType as, as)
+                creq =
+                    CertRequest
+                        certTypes
+                        hashSigs
+                        (map extractCAname serverCACertificates)
+            usingHState ctx $ setCertReqSent True
+            return $ b2 . (creq :)
+        else return b2
+  where
+    commonGroups = negotiatedGroupsInCommon (supportedGroups serverSupported) chExts
+    commonHashSigs = hashAndSignaturesInCommon (supportedHashSignatures serverSupported) chExts
+    setup_DHE = do
+        let possibleFFGroups = commonGroups `intersect` availableFFGroups
+        (dhparams, priv, pub) <-
+            case possibleFFGroups of
+                [] ->
+                    let dhparams = fromJust serverDHEParams
+                     in case findFiniteFieldGroup dhparams of
+                            Just g -> do
+                                usingHState ctx $ setSupportedGroup g
+                                generateFFDHE ctx g
+                            Nothing -> do
+                                (priv, pub) <- generateDHE ctx dhparams
+                                return (dhparams, priv, pub)
+                g : _ -> do
+                    usingHState ctx $ setSupportedGroup g
+                    generateFFDHE ctx g
+
+        let serverParams = serverDHParamsFrom dhparams pub
+
+        usingHState ctx $ setServerDHParams serverParams
+        usingHState ctx $ setDHPrivate priv
+        return serverParams
+
+    -- Choosing a hash algorithm to sign (EC)DHE parameters
+    -- in ServerKeyExchange. Hash algorithm is not suggested by
+    -- the chosen cipher suite. So, it should be selected based on
+    -- the "signature_algorithms" extension in a client hello.
+    -- If RSA is also used for key exchange, this function is
+    -- not called.
+    decideHashSig pubKey = do
+        case filter (pubKey `signatureCompatible`) commonHashSigs of
+            [] -> error ("no hash signature for " ++ pubkeyType pubKey)
+            x : _ -> return x
+
+    generateSKX_DHE kxsAlg = do
+        serverParams <- setup_DHE
+        pubKey <- getLocalPublicKey ctx
+        mhashSig <- decideHashSig pubKey
+        signed <- digitallySignDHParams ctx serverParams pubKey mhashSig
+        case kxsAlg of
+            KX_RSA -> return $ SKX_DHE_RSA serverParams signed
+            KX_DSA -> return $ SKX_DHE_DSA serverParams signed
+            _ ->
+                error ("generate skx_dhe unsupported key exchange signature: " ++ show kxsAlg)
+
+    generateSKX_DH_Anon = SKX_DH_Anon <$> setup_DHE
+
+    setup_ECDHE grp = do
+        usingHState ctx $ setSupportedGroup grp
+        (srvpri, srvpub) <- generateGroup ctx grp
+        let serverParams = ServerECDHParams grp srvpub
+        usingHState ctx $ setServerECDHParams serverParams
+        usingHState ctx $ setGroupPrivate [(grp, srvpri)]
+        return serverParams
+
+    generateSKX_ECDHE kxsAlg = do
+        let possibleECGroups = commonGroups `intersect` availableECGroups
+        grp <- case possibleECGroups of
+            [] -> throwCore $ Error_Protocol "no common group" HandshakeFailure
+            g : _ -> return g
+        serverParams <- setup_ECDHE grp
+        pubKey <- getLocalPublicKey ctx
+        mhashSig <- decideHashSig pubKey
+        signed <- digitallySignECDHParams ctx serverParams pubKey mhashSig
+        case kxsAlg of
+            KX_RSA -> return $ SKX_ECDHE_RSA serverParams signed
+            KX_ECDSA -> return $ SKX_ECDHE_ECDSA serverParams signed
+            _ ->
+                error ("generate skx_ecdhe unsupported key exchange signature: " ++ show kxsAlg)
+
+---
+-- When the client sends a certificate, check whether
+-- it is acceptable for the application.
+--
+---
+makeServerHello
+    :: ServerParams
+    -> Context
+    -> Cipher
+    -> Maybe Credential
+    -> [ExtensionRaw]
+    -> Session
+    -> IO ServerHello
+makeServerHello sparams ctx usedCipher mcred chExts session = do
+    resuming <- usingState_ ctx getTLS12SessionResuming
+    case mcred of
+        Just cred -> storePrivInfoServer ctx cred
+        _ -> return () -- return a sensible error
+    sniExt <- do
+        if resuming
+            then return Nothing
+            else do
+                msni <- usingState_ ctx getClientSNI
+                case msni of
+                    -- RFC6066: In this event, the server SHALL include
+                    -- an extension of type "server_name" in the
+                    -- (extended) server hello. The "extension_data"
+                    -- field of this extension SHALL be empty.
+                    Just _ -> return $ Just $ toExtensionRaw $ ServerName []
+                    Nothing -> return Nothing
+
+    let ecPointExt = case extensionLookup EID_EcPointFormats chExts of
+            Nothing -> Nothing
+            Just _ -> Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed]
+
+    alpnExt <- applicationProtocol ctx chExts sparams
+
+    ems <- usingHState ctx getExtendedMainSecret
+    let emsExt
+            | ems = Just $ toExtensionRaw ExtendedMainSecret
+            | otherwise = Nothing
+
+    let useTicket = sessionUseTicket $ sharedSessionManager $ serverShared sparams
+        sessionTicketExt
+            | not resuming && useTicket = Just $ toExtensionRaw $ SessionTicket ""
+            | otherwise = Nothing
+
+    -- in TLS12, we need to check as well the certificates we are sending if they have in the extension
+    -- the necessary bits set.
+    secReneg <- usingState_ ctx getSecureRenegotiation
+    secureRenegExt <-
+        if secReneg
+            then do
+                vd <- usingState_ ctx $ do
+                    VerifyData cvd <- getVerifyData ClientRole
+                    VerifyData svd <- getVerifyData ServerRole
+                    return $ SecureRenegotiation cvd svd
+                return $ Just $ toExtensionRaw vd
+            else return Nothing
+
+    recodeSizeLimitExt <- processRecordSizeLimit ctx chExts False
+
+    srand <-
+        serverRandom ctx TLS12 $ supportedVersions $ serverSupported sparams
+
+    let shExts =
+            sharedHelloExtensions (serverShared sparams)
+                ++ catMaybes
+                    [ {- 0x00 -} sniExt
+                    , {- 0x0b -} ecPointExt
+                    , {- 0x10 -} alpnExt
+                    , {- 0x17 -} emsExt
+                    , {- 0x1c -} recodeSizeLimitExt
+                    , {- 0x23 -} sessionTicketExt
+                    , {- 0xff01 -} secureRenegExt
+                    ]
+    usingState_ ctx $ setVersion TLS12
+    setServerHelloParameters12 ctx TLS12 srand usedCipher nullCompression
+    return $
+        SH
+            { shVersion = TLS12
+            , shRandom = srand
+            , shSession = session
+            , shCipher = CipherId (cipherID usedCipher)
+            , shComp = 0
+            , shExtensions = shExts
+            }
+
+negotiatedGroupsInCommon :: [Group] -> [ExtensionRaw] -> [Group]
+negotiatedGroupsInCommon serverGroups chExts =
+    lookupAndDecode
+        EID_SupportedGroups
+        MsgTClientHello
+        chExts
+        []
+        common
+  where
+    common (SupportedGroups clientGroups) = serverGroups `intersect` clientGroups
diff --git a/Network/TLS/Handshake/Server/ServerHello13.hs b/Network/TLS/Handshake/Server/ServerHello13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/ServerHello13.hs
@@ -0,0 +1,367 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Server.ServerHello13 (
+    sendServerHello13,
+    sendHRR,
+) where
+
+import Control.Monad.State.Strict
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Credentials
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Control
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Random
+import Network.TLS.Handshake.Server.Common
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+import Network.TLS.X509
+
+sendServerHello13
+    :: ServerParams
+    -> Context
+    -> KeyShareEntry
+    -> (Cipher, Hash, Bool) -- rtt0
+    -> (SecretPair EarlySecret, [ExtensionRaw], Bool, Bool) -- authenticated, is0RTTvalid
+    -> ClientHello
+    -> Maybe ClientRandom
+    -> IO
+        ( SecretTriple ApplicationSecret
+        , ClientTrafficSecret HandshakeSecret
+        , Bool -- authenticated
+        , Bool -- rtt0OK
+        )
+sendServerHello13 sparams ctx clientKeyShare (usedCipher, usedHash, rtt0) (earlyKey, preSharedKeyExt, authenticated, is0RTTvalid) CH{..} mOuterClientRandom = do
+    let clientEarlySecret = pairClient earlyKey
+        earlySecret = pairBase earlyKey
+    -- parse CompressCertificate to check if it is broken here
+    let zlib =
+            lookupAndDecode
+                EID_CompressCertificate
+                MsgTClientHello
+                chExtensions
+                False
+                (\(CompressCertificate ccas) -> CCA_Zlib `elem` ccas)
+
+    recodeSizeLimitExt <- processRecordSizeLimit ctx chExtensions True
+    enableMyRecordLimit ctx
+
+    newSession ctx >>= \ss -> usingState_ ctx $ do
+        setSession ss
+        setTLS13ClientSupportsPHA supportsPHA
+    usingHState ctx $ do
+        setSupportedGroup $ keyShareEntryGroup clientKeyShare
+        setOuterClientRandom mOuterClientRandom
+    hrr <- usingState_ ctx getTLS13HRR
+    alpnExt <- applicationProtocol ctx chExtensions sparams
+    setServerParameter
+    let rtt0OK = authenticated && not hrr && rtt0 && rtt0accept && is0RTTvalid
+    extraCreds <-
+        usingState_ ctx getClientSNI >>= onServerNameIndication (serverHooks sparams)
+    let p = makeCredentialPredicate TLS13 chExtensions
+        allCreds =
+            filterCredentials (isCredentialAllowed TLS13 p) $
+                extraCreds `mappend` sharedCredentials (ctxShared ctx)
+    ----------------------------------------------------------------
+    established <- ctxEstablished ctx
+    if established /= NotEstablished
+        then
+            if rtt0OK
+                then do
+                    usingHState ctx $ setTLS13HandshakeMode RTT0
+                    usingHState ctx $ setTLS13RTT0Status RTT0Accepted
+                else do
+                    usingHState ctx $ setTLS13HandshakeMode PreSharedKey
+                    usingHState ctx $ setTLS13RTT0Status RTT0Rejected
+        else when authenticated $ usingHState ctx $ setTLS13HandshakeMode PreSharedKey
+    -- else : FullHandshake or HelloRetryRequest
+    mCredInfo <-
+        if authenticated then return Nothing else decideCredentialInfo allCreds
+    (ecdhe, keyShare) <- makeServerKeyShare ctx clientKeyShare
+    ensureRecvComplete ctx
+    (clientHandshakeSecret, handSecret) <- runPacketFlight ctx $ do
+        sendServerHello keyShare
+        sendChangeCipherSpec13 ctx
+        ----------------------------------------------------------------
+        handKey <- liftIO $ calculateHandshakeSecret ctx choice earlySecret ecdhe
+        let serverHandshakeSecret = triServer handKey
+            clientHandshakeSecret = triClient handKey
+            handSecret = triBase handKey
+        liftIO $ do
+            if rtt0OK && not (ctxQUICMode ctx)
+                then setRxRecordState ctx usedHash usedCipher clientEarlySecret
+                else setRxRecordState ctx usedHash usedCipher clientHandshakeSecret
+            setTxRecordState ctx usedHash usedCipher serverHandshakeSecret
+            let mEarlySecInfo
+                    | rtt0OK = Just $ EarlySecretInfo usedCipher clientEarlySecret
+                    | otherwise = Nothing
+                handSecInfo = HandshakeSecretInfo usedCipher (clientHandshakeSecret, serverHandshakeSecret)
+            contextSync ctx $ SendServerHello chExtensions mEarlySecInfo handSecInfo
+        ----------------------------------------------------------------
+        liftIO $ enablePeerRecordLimit ctx
+        sendExtensions rtt0OK alpnExt recodeSizeLimitExt
+        case mCredInfo of
+            Nothing -> return ()
+            Just (cred, hashSig) -> sendCertAndVerify cred hashSig zlib
+        let ServerTrafficSecret shs = serverHandshakeSecret
+        rawFinished <- makeFinished ctx usedHash shs
+        loadPacket13 ctx $ Handshake13 [rawFinished] []
+        return (clientHandshakeSecret, handSecret)
+    ----------------------------------------------------------------
+    hChSf <- transcriptHash ctx "CH..SF"
+    appKey <- calculateApplicationSecret ctx choice handSecret hChSf
+    let clientApplicationSecret0 = triClient appKey
+        serverApplicationSecret0 = triServer appKey
+    setTxRecordState ctx usedHash usedCipher serverApplicationSecret0
+    let appSecInfo = ApplicationSecretInfo (clientApplicationSecret0, serverApplicationSecret0)
+    contextSync ctx $ SendServerFinished appSecInfo
+    ----------------------------------------------------------------
+    when rtt0OK $ setEstablished ctx (EarlyDataAllowed rtt0max)
+    return (appKey, clientHandshakeSecret, authenticated, rtt0OK)
+  where
+    choice = makeCipherChoice TLS13 usedCipher
+
+    setServerParameter = do
+        usingState_ ctx $ setVersion TLS13
+        failOnEitherError $ setServerHelloParameters13 ctx usedCipher False
+
+    supportsPHA =
+        lookupAndDecode
+            EID_PostHandshakeAuth
+            MsgTClientHello
+            chExtensions
+            False
+            (\PostHandshakeAuth -> True)
+
+    rtt0max = safeNonNegative32 $ serverEarlyDataSize sparams
+    rtt0accept = serverEarlyDataSize sparams > 0
+
+    decideCredentialInfo allCreds = do
+        let err =
+                throwCore $ Error_Protocol "broken signature_algorithms extension" DecodeError
+        cHashSigs <-
+            lookupAndDecodeAndDo
+                EID_SignatureAlgorithms
+                MsgTClientHello
+                chExtensions
+                err
+                (\(SignatureAlgorithms sas) -> return sas)
+        -- When deciding signature algorithm and certificate, we try to keep
+        -- certificates supported by the client, but fallback to all credentials
+        -- if this produces no suitable result (see RFC 5246 section 7.4.2 and
+        -- RFC 8446 section 4.4.2.2).
+        let sHashSigs = filter isHashSignatureValid13 $ supportedHashSignatures $ ctxSupported ctx
+            hashSigs = sHashSigs `intersect` cHashSigs
+            cltCreds = filterCredentialsWithHashSignatures chExtensions allCreds
+        case credentialsFindForSigning13 hashSigs cltCreds of
+            Nothing ->
+                case credentialsFindForSigning13 hashSigs allCreds of
+                    Nothing -> throwCore $ Error_Protocol "credential not found" HandshakeFailure
+                    mcs -> return mcs
+            mcs -> return mcs
+
+    sendServerHello keyShare = do
+        let keyShareExt = toExtensionRaw $ KeyShareServerHello keyShare
+            versionExt = toExtensionRaw $ SupportedVersionsServerHello TLS13
+            shExts = keyShareExt : versionExt : preSharedKeyExt
+        if isJust mOuterClientRandom
+            then do
+                srand <- liftIO $ serverRandomECH ctx
+                let cipherId = CipherId (cipherID usedCipher)
+                    sh =
+                        SH
+                            { shVersion = TLS12
+                            , shRandom = srand
+                            , shSession = chSession
+                            , shCipher = cipherId
+                            , shComp = 0
+                            , shExtensions = shExts
+                            }
+                suffix <- computeConfirm ctx usedHash sh "ech accept confirmation"
+                let srand' = replaceServerRandomECH srand suffix
+                    sh' =
+                        SH
+                            { shVersion = TLS12
+                            , shRandom = srand'
+                            , shSession = chSession
+                            , shCipher = cipherId
+                            , shComp = 0
+                            , shExtensions = shExts
+                            }
+                usingHState ctx $ setECHAccepted True
+                loadPacket13 ctx $ Handshake13 [ServerHello13 sh'] []
+            else do
+                srand <-
+                    liftIO $
+                        serverRandom ctx TLS13 $
+                            supportedVersions $
+                                serverSupported sparams
+                let sh =
+                        SH
+                            { shVersion = TLS12
+                            , shRandom = srand
+                            , shSession = chSession
+                            , shCipher = CipherId (cipherID usedCipher)
+                            , shComp = 0
+                            , shExtensions = shExts
+                            }
+                loadPacket13 ctx $ Handshake13 [ServerHello13 sh] []
+
+    sendCertAndVerify cred@(certChain, _) hashSig zlib = do
+        storePrivInfoServer ctx cred
+        when (serverWantClientCert sparams) $ do
+            let certReqCtx = "" -- this must be zero length here.
+                certReq = makeCertRequest sparams ctx certReqCtx True
+            loadPacket13 ctx $ Handshake13 [certReq] []
+            usingHState ctx $ setCertReqSent True
+
+        let CertificateChain cs = certChain
+            ess = replicate (length cs) []
+        let certtag = if zlib then CompressedCertificate13 else Certificate13
+        loadPacket13 ctx $
+            Handshake13 [certtag "" (CertificateChain_ certChain) ess] []
+        liftIO $ usingState_ ctx $ setServerCertificateChain certChain
+        hChSc <- transcriptHash ctx "CH..SC"
+        pubkey <- getLocalPublicKey ctx
+        vrfy <- makeCertVerify ctx pubkey hashSig hChSc
+        loadPacket13 ctx $ Handshake13 [vrfy] []
+
+    sendExtensions rtt0OK alpnExt recodeSizeLimitExt = do
+        msni <- liftIO $ usingState_ ctx getClientSNI
+        let sniExt = case msni of
+                -- RFC6066: In this event, the server SHALL include
+                -- an extension of type "server_name" in the
+                -- (extended) server hello. The "extension_data"
+                -- field of this extension SHALL be empty.
+                Just _ -> Just $ toExtensionRaw $ ServerName []
+                Nothing -> Nothing
+
+        mgroup <- usingHState ctx getSupportedGroup
+        let serverGroups = supportedGroups (ctxSupported ctx)
+            groupExt = case serverGroups of
+                [] -> Nothing
+                rg : _ -> case mgroup of
+                    Nothing -> Nothing
+                    Just grp
+                        | grp == rg -> Nothing
+                        | otherwise -> Just $ toExtensionRaw $ SupportedGroups serverGroups
+        let earlyDataExt
+                | rtt0OK = Just $ toExtensionRaw $ EarlyDataIndication Nothing
+                | otherwise = Nothing
+
+        sendECH <- usingHState ctx getECHEE
+        let echExt
+                | sendECH =
+                    Just $
+                        toExtensionRaw $
+                            ECHEncryptedExtensions $
+                                sharedECHConfigList $
+                                    serverShared sparams
+                | otherwise = Nothing
+        let eeExtensions =
+                sharedHelloExtensions (serverShared sparams)
+                    ++ catMaybes
+                        [ {- 0x00 -} sniExt
+                        , {- 0x0a -} groupExt
+                        , {- 0x10 -} alpnExt
+                        , {- 0x1c -} recodeSizeLimitExt
+                        , {- 0x2a -} earlyDataExt
+                        , {- 0xfe0d -} echExt
+                        ]
+        eeExtensions' <-
+            liftIO $ onEncryptedExtensionsCreating (serverHooks sparams) eeExtensions
+        loadPacket13 ctx $ Handshake13 [EncryptedExtensions13 eeExtensions'] []
+
+credentialsFindForSigning13
+    :: [HashAndSignatureAlgorithm]
+    -> Credentials
+    -> Maybe (Credential, HashAndSignatureAlgorithm)
+credentialsFindForSigning13 hss0 creds = loop hss0
+  where
+    loop [] = Nothing
+    loop (hs : hss) = case credentialsFindForSigning13' hs creds of
+        Nothing -> loop hss
+        Just cred -> Just (cred, hs)
+
+-- See credentialsFindForSigning.
+credentialsFindForSigning13'
+    :: HashAndSignatureAlgorithm -> Credentials -> Maybe Credential
+credentialsFindForSigning13' sigAlg (Credentials l) = find forSigning l
+  where
+    forSigning cred = case credentialDigitalSignatureKey cred of
+        Nothing -> False
+        Just pub -> pub `signatureCompatible13` sigAlg
+
+contextSync :: Context -> ServerState -> IO ()
+contextSync ctx ctl = case ctxHandshakeSync ctx of
+    HandshakeSync _ sync -> sync ctx ctl
+
+----------------------------------------------------------------
+
+sendHRR :: Context -> Group -> (Cipher, Hash, c) -> ClientHello -> Bool -> IO ()
+sendHRR ctx g (usedCipher, usedHash, _) CH{..} isEch = do
+    twice <- usingState_ ctx getTLS13HRR
+    when twice $
+        throwCore $
+            Error_Protocol "Hello retry not allowed again" HandshakeFailure
+    usingState_ ctx $ setTLS13HRR True
+    failOnEitherError $ setServerHelloParameters13 ctx usedCipher True
+    hrr <- makeHRR ctx usedCipher usedHash chSession g isEch
+    usingHState ctx $ setTLS13HandshakeMode HelloRetryRequest
+    runPacketFlight ctx $ do
+        loadPacket13 ctx $ Handshake13 [ServerHello13 hrr] []
+        sendChangeCipherSpec13 ctx
+
+makeHRR
+    :: Context -> Cipher -> Hash -> Session -> Group -> Bool -> IO ServerHello
+makeHRR _ usedCipher _ session g False = return hrr
+  where
+    keyShareExt = toExtensionRaw $ KeyShareHRR g
+    versionExt = toExtensionRaw $ SupportedVersionsServerHello TLS13
+    extensions = [keyShareExt, versionExt]
+    cipherId = CipherId $ cipherID usedCipher
+    hrr =
+        SH
+            { shVersion = TLS12
+            , shRandom = hrrRandom
+            , shSession = session
+            , shCipher = cipherId
+            , shComp = 0
+            , shExtensions = extensions
+            }
+makeHRR ctx usedCipher usedHash session g True = do
+    suffix <- computeConfirm ctx usedHash hrr "hrr ech accept confirmation"
+    let echExt' = toExtensionRaw $ ECHHelloRetryRequest suffix
+        extensions' = [keyShareExt, versionExt, echExt']
+        hrr' = hrr{shExtensions = extensions'}
+    return hrr'
+  where
+    keyShareExt = toExtensionRaw $ KeyShareHRR g
+    versionExt = toExtensionRaw $ SupportedVersionsServerHello TLS13
+    echExt = toExtensionRaw $ ECHHelloRetryRequest "\x00\x00\x00\x00\x00\x00\x00\x00"
+    extensions = [keyShareExt, versionExt, echExt]
+    cipherId = CipherId $ cipherID usedCipher
+    hrr =
+        SH
+            { shVersion = TLS12
+            , shRandom = hrrRandom
+            , shSession = session
+            , shCipher = cipherId
+            , shComp = 0
+            , shExtensions = extensions
+            }
diff --git a/Network/TLS/Handshake/Server/TLS12.hs b/Network/TLS/Handshake/Server/TLS12.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/TLS12.hs
@@ -0,0 +1,216 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.Server.TLS12 (
+    recvClientSecondFlight12,
+) where
+
+import Control.Monad.State.Strict (gets)
+import Data.ByteArray (convert)
+import qualified Data.ByteString as B
+
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Server.Common
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Packet hiding (getSession)
+import Network.TLS.Parameters
+import Network.TLS.Session
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Types
+import Network.TLS.X509 hiding (Certificate)
+
+----------------------------------------------------------------
+
+recvClientSecondFlight12
+    :: ServerParams
+    -> Context
+    -> Maybe SessionData
+    -> IO ()
+recvClientSecondFlight12 sparams ctx resumeSessionData = do
+    case resumeSessionData of
+        Nothing -> do
+            recvClientCCC sparams ctx
+            mticket <- sessionEstablished ctx
+            case mticket of
+                Nothing -> return ()
+                Just ticket -> do
+                    let life = adjustLifetime $ serverTicketLifetime sparams
+                    sendPacket12 ctx $ Handshake [NewSessionTicket life ticket] []
+            sendCCSandFinished ctx ServerRole
+        Just _ -> do
+            _ <- sessionEstablished ctx
+            recvCCSandFinished ctx
+    finishHandshake12 ctx
+  where
+    adjustLifetime i
+        | i < 0 = 0
+        | i > 604800 = 604800
+        | otherwise = fromIntegral i
+
+sessionEstablished :: Context -> IO (Maybe Ticket)
+sessionEstablished ctx = do
+    session <- usingState_ ctx getSession
+    -- only callback the session established if we have a session
+    case session of
+        Session (Just sessionId) -> do
+            sessionData <- getSessionData ctx
+            let sessionId' = B.copy sessionId
+            -- SessionID method: SessionID is used as key to store
+            -- SessionData. Nothing is returned.
+            --
+            -- Session ticket method: SessionID is ignored. SessionData
+            -- is encrypted and returned.
+            sessionEstablish
+                (sharedSessionManager $ ctxShared ctx)
+                sessionId'
+                (fromJust sessionData)
+        _ -> return Nothing -- never reach
+
+----------------------------------------------------------------
+
+-- | receive Client data in handshake until the Finished handshake.
+--
+--      <- [certificate]
+--      <- client key xchg
+--      <- [cert verify]
+--      <- change cipher
+--      <- finish
+recvClientCCC :: ServerParams -> Context -> IO ()
+recvClientCCC sparams ctx = runRecvState ctx (RecvStateHandshake expectClientCertificate)
+  where
+    expectClientCertificate (Certificate (CertificateChain_ certs)) = do
+        clientCertificate sparams ctx certs
+        processCertificate ctx ServerRole certs
+
+        -- FIXME: We should check whether the certificate
+        -- matches our request and that we support
+        -- verifying with that certificate.
+
+        return $ RecvStateHandshake $ expectClientKeyExchange True
+    expectClientCertificate p = expectClientKeyExchange False p
+
+    -- cannot use RecvStateHandshake, as the next message could be a ChangeCipher,
+    -- so we must process any packet, and in case of handshake call processHandshake manually.
+    expectClientKeyExchange followedCertVerify (ClientKeyXchg ckx) = do
+        processClientKeyXchg ctx ckx
+        if followedCertVerify
+            then return $ RecvStateHandshake expectCertificateVerify
+            else return $ RecvStatePacket $ expectChangeCipherSpec ctx
+    expectClientKeyExchange _ p = unexpected (show p) (Just "client key exchange")
+
+    expectCertificateVerify (CertVerify dsig) = do
+        certs <- checkValidClientCertChain ctx "change cipher message expected"
+
+        usedVersion <- usingState_ ctx getVersion
+        -- Fetch all handshake messages up to now.
+        msgs <- usingHState ctx $ B.concat <$> getHandshakeMessages
+
+        pubKey <- usingHState ctx getRemotePublicKey
+        checkDigitalSignatureKey usedVersion pubKey
+
+        verif <- checkCertificateVerify ctx usedVersion pubKey msgs dsig
+        processClientCertVerify sparams ctx certs verif
+        return $ RecvStatePacket $ expectChangeCipherSpec ctx
+    expectCertificateVerify p = unexpected (show p) (Just "client certificate verify")
+
+----------------------------------------------------------------
+
+expectChangeCipherSpec :: Context -> Packet -> IO (RecvState IO)
+expectChangeCipherSpec ctx ChangeCipherSpec = do
+    enableMyRecordLimit ctx
+    return $ RecvStateHandshake $ expectFinished ctx
+expectChangeCipherSpec _ p = unexpected (show p) (Just "change cipher")
+
+----------------------------------------------------------------
+
+-- process the client key exchange message. the protocol expects the initial
+-- client version received in ClientHello, not the negotiated version.
+-- in case the version mismatch, generate a random main secret
+processClientKeyXchg :: Context -> ClientKeyXchgAlgorithmData -> IO ()
+processClientKeyXchg ctx (CKX_RSA encryptedPreMain) = do
+    (rver, role, random) <- usingState_ ctx $ do
+        (,,) <$> getVersion <*> getRole <*> genRandom 48
+    ePreMain <- decryptRSA ctx encryptedPreMain
+    expectedVer <- usingHState ctx $ gets hstClientVersion
+    mainSecret <- case ePreMain of
+        Left _ ->
+            -- BadRecordMac is nonsense but for tlsfuzzer
+            throwCore $
+                Error_Protocol "invalid client public key" BadRecordMac
+        Right preMain -> case decodePreMainSecret $ convert preMain of
+            Left _ -> usingHState ctx $ setMainSecretFromPre rver role $ convert random
+            Right (ver, _)
+                | ver /= expectedVer ->
+                    usingHState ctx $ setMainSecretFromPre rver role $ convert random
+                | otherwise -> usingHState ctx $ setMainSecretFromPre rver role preMain
+    logKey ctx (MainSecret mainSecret)
+processClientKeyXchg ctx (CKX_DH clientDHValue) = do
+    rver <- usingState_ ctx getVersion
+    role <- usingState_ ctx getRole
+
+    serverParams <- usingHState ctx getServerDHParams
+    let params = serverDHParamsToParams serverParams
+    unless (dhValid params $ dhUnwrapPublic clientDHValue) $
+        throwCore $
+            Error_Protocol "invalid client public key" IllegalParameter
+
+    dhpriv <- usingHState ctx getDHPrivate
+    let preMain = dhGetShared params dhpriv clientDHValue
+    mainSecret <- usingHState ctx $ setMainSecretFromPre rver role preMain
+    logKey ctx (MainSecret mainSecret)
+processClientKeyXchg ctx (CKX_ECDH bytes) = do
+    ServerECDHParams grp _ <- usingHState ctx getServerECDHParams
+    case groupDecodePublicB grp bytes of
+        Left _ ->
+            throwCore $
+                Error_Protocol "client public key cannot be decoded" IllegalParameter
+        Right clipub -> do
+            grpSpris <- usingHState ctx getGroupPrivate
+            case lookup grp grpSpris of
+                Nothing -> throwCore err
+                Just srvpri -> case groupDecapsulate clipub srvpri of
+                    Just preMain -> do
+                        rver <- usingState_ ctx getVersion
+                        role <- usingState_ ctx getRole
+                        mainSecret <- usingHState ctx $ setMainSecretFromPre rver role preMain
+                        logKey ctx (MainSecret mainSecret)
+                    Nothing -> throwCore err
+  where
+    err = Error_Protocol "cannot generate a shared secret on ECDH" IllegalParameter
+
+----------------------------------------------------------------
+
+processClientCertVerify
+    :: ServerParams -> Context -> CertificateChain -> Bool -> IO ()
+processClientCertVerify _sparams ctx certs True = do
+    -- When verification succeeds, commit the
+    -- client certificate chain to the context.
+    --
+    usingState_ ctx $ setClientCertificateChain certs
+    return ()
+processClientCertVerify sparams ctx certs False = do
+    -- Either verification failed because of an
+    -- invalid format (with an error message), or
+    -- the signature is wrong.  In either case,
+    -- ask the application if it wants to
+    -- proceed, we will do that.
+    res <- onUnverifiedClientCert (serverHooks sparams)
+    if res
+        then do
+            -- When verification fails, but the
+            -- application callbacks accepts, we
+            -- also commit the client certificate
+            -- chain to the context.
+            usingState_ ctx $ setClientCertificateChain certs
+        else decryptError "verification failed"
+
+----------------------------------------------------------------
+
+recvCCSandFinished :: Context -> IO ()
+recvCCSandFinished ctx = runRecvState ctx $ RecvStatePacket $ expectChangeCipherSpec ctx
diff --git a/Network/TLS/Handshake/Server/TLS13.hs b/Network/TLS/Handshake/Server/TLS13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/Server/TLS13.hs
@@ -0,0 +1,387 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Handshake.Server.TLS13 (
+    recvClientSecondFlight13,
+    requestCertificateServer,
+    keyUpdate,
+    updateKey,
+    KeyUpdateRequest (..),
+) where
+
+import Control.Exception
+import Control.Monad.State.Strict
+import Data.IORef
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import Network.TLS.Extension
+import Network.TLS.Handshake.Common hiding (expectFinished)
+import Network.TLS.Handshake.Common13
+import Network.TLS.Handshake.Key
+import Network.TLS.Handshake.Server.Common
+import Network.TLS.Handshake.Signature
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.KeySchedule
+import Network.TLS.Parameters
+import Network.TLS.Session
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+import Network.TLS.Util
+import Network.TLS.X509
+
+----------------------------------------------------------------
+
+recvClientSecondFlight13
+    :: ServerParams
+    -> Context
+    -> ( SecretTriple ApplicationSecret
+       , ClientTrafficSecret HandshakeSecret
+       , Bool
+       , Bool
+       )
+    -> ClientHello
+    -> IO ()
+recvClientSecondFlight13 sparams ctx (appKey, clientHandshakeSecret, authenticated, rtt0OK) CH{..} = do
+    sfSentTime <- getCurrentTimeFromBase
+    let expectFinished' =
+            expectFinished sparams ctx chExtensions appKey clientHandshakeSecret sfSentTime
+    if not authenticated && serverWantClientCert sparams
+        then runRecvHandshake13 $ do
+            -- RFC 8446 Sec 4.4.3: Clients MUST send this message
+            -- whenever authenticating via a certificate (i.e., when the
+            -- Certificate message is non-empty).  When sent, this message MUST
+            -- appear immediately after the Certificate message and immediately
+            -- prior to the Finished message.
+            skip <- recvHandshake13 ctx $ expectCertificate sparams ctx
+            unless skip $
+                recvHandshake13hash ctx "CertVerify" (expectCertVerify sparams ctx)
+            recvHandshake13hash ctx "Finished" expectFinished'
+            ensureRecvComplete ctx
+        else
+            if rtt0OK && not (ctxQUICMode ctx)
+                then
+                    setPendingRecvActions
+                        ctx
+                        [ PendingRecvAction True $ expectEndOfEarlyData ctx clientHandshakeSecret
+                        , PendingRecvActionHash True $
+                            expectFinished sparams ctx chExtensions appKey clientHandshakeSecret sfSentTime
+                        ]
+                else runRecvHandshake13 $ do
+                    recvHandshake13hash ctx "Finished" expectFinished'
+                    ensureRecvComplete ctx
+
+expectFinished
+    :: MonadIO m
+    => ServerParams
+    -> Context
+    -> [ExtensionRaw]
+    -> SecretTriple ApplicationSecret
+    -> ClientTrafficSecret HandshakeSecret
+    -> Word64
+    -> TranscriptHash
+    -> Handshake13
+    -> m ()
+expectFinished sparams ctx exts appKey clientHandshakeSecret sfSentTime hChBeforeCf (Finished13 verifyData) = liftIO $ do
+    modifyTLS13State ctx $ \st -> st{tls13stRecvCF = True}
+    (usedHash, usedCipher, _, _) <- getRxRecordState ctx
+    let ClientTrafficSecret chs = clientHandshakeSecret
+    checkFinished ctx usedHash chs hChBeforeCf verifyData
+    finishHandshake13 ctx
+    setRxRecordState ctx usedHash usedCipher clientApplicationSecret0
+    sendNewSessionTicket sparams ctx usedCipher exts applicationSecret sfSentTime
+  where
+    applicationSecret = triBase appKey
+    clientApplicationSecret0 = triClient appKey
+expectFinished _ _ _ _ _ _ _ hs = unexpected (show hs) (Just "finished 13")
+
+expectEndOfEarlyData
+    :: Context
+    -> ClientTrafficSecret HandshakeSecret
+    -> Handshake13
+    -> IO ()
+expectEndOfEarlyData ctx clientHandshakeSecret EndOfEarlyData13 = do
+    (usedHash, usedCipher, _, _) <- getRxRecordState ctx
+    setRxRecordState ctx usedHash usedCipher clientHandshakeSecret
+expectEndOfEarlyData _ _ hs = unexpected (show hs) (Just "end of early data")
+
+expectCertificate
+    :: MonadIO m => ServerParams -> Context -> Handshake13 -> m Bool
+expectCertificate sparams ctx (Certificate13 certCtx (CertificateChain_ certs) _ext) = liftIO $ do
+    when (certCtx /= "") $
+        throwCore $
+            Error_Protocol "certificate request context MUST be empty" IllegalParameter
+    -- fixme checking _ext
+    clientCertificate sparams ctx certs
+    return $ isNullCertificateChain certs
+expectCertificate sparams ctx (CompressedCertificate13 certCtx (CertificateChain_ certs) _ext) = liftIO $ do
+    when (certCtx /= "") $
+        throwCore $
+            Error_Protocol "certificate request context MUST be empty" IllegalParameter
+    -- fixme checking _ext
+    clientCertificate sparams ctx certs
+    return $ isNullCertificateChain certs
+expectCertificate _ _ hs = unexpected (show hs) (Just "certificate 13")
+
+sendNewSessionTicket
+    :: ServerParams
+    -> Context
+    -> Cipher
+    -> [ExtensionRaw]
+    -> BaseSecret ApplicationSecret
+    -> Word64
+    -> IO ()
+sendNewSessionTicket sparams ctx usedCipher exts applicationSecret sfSentTime = when sendNST $ do
+    cfRecvTime <- getCurrentTimeFromBase
+    let rtt = cfRecvTime - sfSentTime
+    nonce <- TicketNonce <$> getStateRNG ctx 32
+    resumptionSecret <- calculateResumptionSecret ctx choice applicationSecret
+    let life = adjustLifetime $ serverTicketLifetime sparams
+        psk = derivePSK choice resumptionSecret nonce
+    (identity, add) <- generateSession life psk rtt0max rtt
+    let nst = createNewSessionTicket life add nonce identity rtt0max
+    sendPacket13 ctx $ Handshake13 [nst] []
+  where
+    choice = makeCipherChoice TLS13 usedCipher
+    rtt0max = safeNonNegative32 $ serverEarlyDataSize sparams
+    sendNST = PSK_DHE_KE `elem` dhModes
+
+    dhModes = case extensionLookup EID_PskKeyExchangeModes exts
+        >>= extensionDecode MsgTClientHello of
+        Just (PskKeyExchangeModes ms) -> ms
+        Nothing -> []
+
+    generateSession life psk maxSize rtt = do
+        Session (Just sessionId) <- newSession ctx
+        tinfo <- createTLS13TicketInfo life (Left ctx) (Just rtt)
+        sdata <- getSessionData13 ctx usedCipher tinfo maxSize psk
+        let mgr = sharedSessionManager $ serverShared sparams
+        mticket <- sessionEstablish mgr sessionId sdata
+        let identity = SessionIDorTicket_ $ fromMaybe sessionId mticket
+        return (identity, ageAdd tinfo)
+
+    createNewSessionTicket life add nonce identity maxSize =
+        NewSessionTicket13 life add nonce identity nstExtensions
+      where
+        nstExtensions
+            | maxSize == 0 = []
+            | otherwise = [earlyDataExt]
+          where
+            earlyDataExt = toExtensionRaw $ EarlyDataIndication $ Just $ fromIntegral maxSize
+    adjustLifetime i
+        | i < 0 = 0
+        | i > 604800 = 604800
+        | otherwise = fromIntegral i
+
+expectCertVerify
+    :: MonadIO m
+    => ServerParams -> Context -> TranscriptHash -> Handshake13 -> m ()
+expectCertVerify sparams ctx (TranscriptHash hChCc) (CertVerify13 (DigitallySigned sigAlg sig)) = liftIO $ do
+    certs@(CertificateChain cc) <-
+        checkValidClientCertChain ctx "invalid client certificate chain"
+    pubkey <- case cc of
+        [] -> throwCore $ Error_Protocol "client certificate missing" HandshakeFailure
+        c : _ -> return $ certPubKey $ getCertificate c
+    ver <- usingState_ ctx getVersion
+    checkDigitalSignatureKey ver pubkey
+    usingHState ctx $ setPublicKey pubkey
+    verif <- checkCertVerify ctx pubkey sigAlg sig hChCc
+    clientCertVerify sparams ctx certs verif
+expectCertVerify _ _ _ hs = unexpected (show hs) (Just "certificate verify 13")
+
+clientCertVerify :: ServerParams -> Context -> CertificateChain -> Bool -> IO ()
+clientCertVerify sparams ctx certs verif = do
+    if verif
+        then do
+            -- When verification succeeds, commit the
+            -- client certificate chain to the context.
+            --
+            usingState_ ctx $ setClientCertificateChain certs
+            return ()
+        else do
+            -- Either verification failed because of an
+            -- invalid format (with an error message), or
+            -- the signature is wrong.  In either case,
+            -- ask the application if it wants to
+            -- proceed, we will do that.
+            res <- liftIO $ onUnverifiedClientCert (serverHooks sparams)
+            if res
+                then do
+                    -- When verification fails, but the
+                    -- application callbacks accepts, we
+                    -- also commit the client certificate
+                    -- chain to the context.
+                    usingState_ ctx $ setClientCertificateChain certs
+                else decryptError "verification failed"
+
+----------------------------------------------------------------
+
+newCertReqContext :: Context -> IO CertReqContext
+newCertReqContext ctx = getStateRNG ctx 32
+
+requestCertificateServer :: ServerParams -> Context -> IO Bool
+requestCertificateServer sparams ctx = handleEx ctx $ do
+    tls13 <- tls13orLater ctx
+    supportsPHA <- usingState_ ctx getTLS13ClientSupportsPHA
+    let ok = tls13 && supportsPHA
+    if ok
+        then newIORef [] >>= sendCertReqAndRecv
+        else return ok
+  where
+    sendCertReqAndRecv ref = do
+        origCertReqCtx <- newCertReqContext ctx
+        let certReq13 = makeCertRequest sparams ctx origCertReqCtx False
+        _ <- withWriteLock ctx $ do
+            bracket (saveHState ctx) (restoreHState ctx) $ \_ -> do
+                sendPacket13 ctx $ Handshake13 [certReq13] []
+        withReadLock ctx $ do
+            (clientCert13, bClientCert13) <- getHandshake ctx ref
+            emptyCert <- expectClientCertificate sparams ctx origCertReqCtx clientCert13
+            baseHState <- saveHState ctx
+            updateTranscriptHash13 ctx (clientCert13, bClientCert13)
+            th <- transcriptHash ctx "CH..Cert"
+            unless emptyCert $ do
+                (certVerify13, bCertVerify13) <- getHandshake ctx ref
+                expectCertVerify sparams ctx th certVerify13
+                updateTranscriptHash13 ctx (certVerify13, bCertVerify13)
+            (finished13, _bFinished13) <- getHandshake ctx ref
+            expectClientFinished ctx finished13
+            void $ restoreHState ctx baseHState -- fixme
+        return True
+
+-- saving appdata and key update?
+-- error handling
+getHandshake
+    :: Context -> IORef [Handshake13R] -> IO Handshake13R
+getHandshake ctx ref = do
+    hhs <- readIORef ref
+    if null hhs
+        then do
+            ex <- recvPacket13 ctx
+            either (terminate ctx) process ex
+        else chk hhs
+  where
+    process (Handshake13 hss bss) = chk $ zip hss bss
+    process _ =
+        terminate ctx $
+            Error_Protocol "post handshake authenticated" UnexpectedMessage
+    chk [] = getHandshake ctx ref
+    chk ((KeyUpdate13 mode, _) : hbs) = do
+        keyUpdate ctx getRxRecordState setRxRecordState
+        -- Write lock wraps both actions because we don't want another
+        -- packet to be sent by another thread before the Tx state is
+        -- updated.
+        when (mode == UpdateRequested) $ withWriteLock ctx $ do
+            sendPacket13 ctx $ Handshake13 [KeyUpdate13 UpdateNotRequested] []
+            keyUpdate ctx getTxRecordState setTxRecordState
+        chk hbs
+    chk (hb : hbs) = do
+        writeIORef ref hbs
+        return hb
+
+expectClientCertificate
+    :: ServerParams -> Context -> CertReqContext -> Handshake13 -> IO Bool
+expectClientCertificate sparams ctx origCertReqCtx (Certificate13 certReqCtx (CertificateChain_ certs) _ext) = do
+    expectClientCertificate' sparams ctx origCertReqCtx certReqCtx certs
+    return $ isNullCertificateChain certs
+expectClientCertificate sparams ctx origCertReqCtx (CompressedCertificate13 certReqCtx (CertificateChain_ certs) _ext) = do
+    expectClientCertificate' sparams ctx origCertReqCtx certReqCtx certs
+    return $ isNullCertificateChain certs
+expectClientCertificate _ _ _ h = unexpected "Certificate" $ Just $ show h
+
+expectClientCertificate'
+    :: ServerParams
+    -> Context
+    -> CertReqContext
+    -> CertReqContext
+    -> CertificateChain
+    -> IO ()
+expectClientCertificate' sparams ctx origCertReqCtx certReqCtx certs = do
+    when (origCertReqCtx /= certReqCtx) $
+        throwCore $
+            Error_Protocol "certificate context is wrong" IllegalParameter
+    void $ clientCertificate sparams ctx certs
+
+expectClientFinished :: Context -> Handshake13 -> IO ()
+expectClientFinished ctx (Finished13 verifyData) = do
+    (usedHash, _, level, applicationSecretN) <- getRxRecordState ctx
+    unless (level == CryptApplicationSecret) $
+        throwCore $
+            Error_Protocol
+                "tried post-handshake authentication without application traffic secret"
+                InternalError
+    hChBeforeCf <- transcriptHash ctx "CH..<CF"
+    checkFinished ctx usedHash applicationSecretN hChBeforeCf verifyData
+expectClientFinished _ h = unexpected "Finished" $ Just $ show h
+
+terminate :: Context -> TLSError -> IO a
+terminate ctx err = do
+    let (level, desc) = errorToAlert err
+        reason = errorToAlertMessage err
+        send = sendPacket13 ctx . Alert13
+    catchException (send [(level, desc)]) (\_ -> return ())
+    setEOF ctx
+    throwIO $ Terminated False reason err
+
+handleEx :: Context -> IO Bool -> IO Bool
+handleEx ctx f = catchException f $ \exception -> do
+    -- If the error was an Uncontextualized TLSException, we replace the
+    -- context with HandshakeFailed. If it's anything else, we convert
+    -- it to a string and wrap it with Error_Misc and HandshakeFailed.
+    let tlserror = case fromException exception of
+            Just e | Uncontextualized e' <- e -> e'
+            _ -> Error_Misc (show exception)
+    sendPacket13 ctx $ Alert13 [errorToAlert tlserror]
+    void $ throwIO $ PostHandshake tlserror
+    return False
+
+----------------------------------------------------------------
+
+keyUpdate
+    :: Context
+    -> (Context -> IO (Hash, Cipher, CryptLevel, Secret))
+    -> (Context -> Hash -> Cipher -> AnyTrafficSecret ApplicationSecret -> IO ())
+    -> IO ()
+keyUpdate ctx getState setState = do
+    (usedHash, usedCipher, level, applicationSecretN) <- getState ctx
+    unless (level == CryptApplicationSecret) $
+        throwCore $
+            Error_Protocol
+                "tried key update without application traffic secret"
+                InternalError
+    let applicationSecretN1 =
+            hkdfExpandLabel usedHash applicationSecretN "traffic upd" "" $
+                hashDigestSize usedHash
+    setState ctx usedHash usedCipher (AnyTrafficSecret applicationSecretN1)
+
+-- | How to update keys in TLS 1.3
+data KeyUpdateRequest
+    = -- | Unidirectional key update
+      OneWay
+    | -- | Bidirectional key update (normal case)
+      TwoWay
+    deriving (Eq, Show)
+
+-- | Updating application traffic secrets for TLS 1.3.
+--   If this API is called for TLS 1.3, 'True' is returned.
+--   Otherwise, 'False' is returned.
+updateKey :: MonadIO m => Context -> KeyUpdateRequest -> m Bool
+updateKey ctx way = liftIO $ do
+    tls13 <- tls13orLater ctx
+    when tls13 $ do
+        let req = case way of
+                OneWay -> UpdateNotRequested
+                TwoWay -> UpdateRequested
+        -- Write lock wraps both actions because we don't want another packet to
+        -- be sent by another thread before the Tx state is updated.
+        withWriteLock ctx $ do
+            sendPacket13 ctx $ Handshake13 [KeyUpdate13 req] []
+            keyUpdate ctx getTxRecordState setTxRecordState
+    return tls13
diff --git a/Network/TLS/Handshake/Signature.hs b/Network/TLS/Handshake/Signature.hs
--- a/Network/TLS/Handshake/Signature.hs
+++ b/Network/TLS/Handshake/Signature.hs
@@ -1,109 +1,305 @@
 {-# LANGUAGE OverloadedStrings #-}
--- |
--- Module      : Network.TLS.Handshake.Signature
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Handshake.Signature
-    ( getHashAndASN1
-    , prepareCertificateVerifySignatureData
-    , signatureHashData
-    , signatureCreate
-    , signatureVerify
-    , signatureVerifyWithHashDescr
-    , generateSignedDHParams
-    ) where
 
-import Crypto.PubKey.HashDescr
-import Network.TLS.Crypto
+module Network.TLS.Handshake.Signature (
+    createCertificateVerify,
+    checkCertificateVerify,
+    digitallySignDHParams,
+    digitallySignECDHParams,
+    digitallySignDHParamsVerify,
+    digitallySignECDHParamsVerify,
+    checkSupportedHashSignature,
+    certificateCompatible,
+    signatureCompatible,
+    signatureCompatible13,
+    hashSigToCertType,
+    signatureParams,
+    decryptError,
+) where
+
+import Control.Monad.State.Strict
+
 import Network.TLS.Context.Internal
-import Network.TLS.Struct
-import Network.TLS.Packet (generateCertificateVerify_SSL, encodeSignedDHParams)
-import Network.TLS.State
-import Network.TLS.Handshake.State
+import Network.TLS.Crypto
 import Network.TLS.Handshake.Key
-import Network.TLS.Util
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Packet (
+    encodeSignedDHParams,
+    encodeSignedECDHParams,
+ )
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.X509
 
-import Control.Applicative
-import Control.Monad.State
+decryptError :: MonadIO m => String -> m a
+decryptError msg = throwCore $ Error_Protocol msg DecryptError
 
-getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m HashDescr
-getHashAndASN1 hashSig = case hashSig of
-    (HashSHA1,   SignatureRSA) -> return hashDescrSHA1
-    (HashSHA224, SignatureRSA) -> return hashDescrSHA224
-    (HashSHA256, SignatureRSA) -> return hashDescrSHA256
-    (HashSHA384, SignatureRSA) -> return hashDescrSHA384
-    (HashSHA512, SignatureRSA) -> return hashDescrSHA512
-    _                          -> throwCore $ Error_Misc "unsupported hash/sig algorithm"
+-- | Check that the key is compatible with a list of 'CertificateType' values.
+-- Ed25519 and Ed448 have no assigned code point and are checked with extension
+-- "signature_algorithms" only.
+certificateCompatible :: PubKey -> [CertificateType] -> Bool
+certificateCompatible (PubKeyRSA _) cTypes = CertificateType_RSA_Sign `elem` cTypes
+certificateCompatible (PubKeyDSA _) cTypes = CertificateType_DSA_Sign `elem` cTypes
+certificateCompatible (PubKeyEC _) cTypes = CertificateType_ECDSA_Sign `elem` cTypes
+certificateCompatible (PubKeyEd25519 _) _ = True
+certificateCompatible (PubKeyEd448 _) _ = True
+certificateCompatible _ _ = False
 
-prepareCertificateVerifySignatureData :: Context
-                                      -> Version
-                                      -> Maybe HashAndSignatureAlgorithm
-                                      -> Bytes
-                                      -> IO (HashDescr, Bytes)
-prepareCertificateVerifySignatureData ctx usedVersion malg msgs
-    | usedVersion == SSL3 = do
-        Just masterSecret <- usingHState ctx $ gets hstMasterSecret
-        let digest = generateCertificateVerify_SSL masterSecret (hashUpdate (hashInit hashMD5SHA1) msgs)
-            hsh = HashDescr id id
-        return (hsh, digest)
-    | usedVersion == TLS10 || usedVersion == TLS11 = do
-        let hashf bs = hashFinal (hashUpdate (hashInit hashMD5SHA1) bs)
-            hsh = HashDescr hashf id
-        return (hsh, msgs)
-    | otherwise = do
-        let Just hashSig = malg
-        hsh <- getHashAndASN1 hashSig
-        return (hsh, msgs)
+signatureCompatible :: PubKey -> HashAndSignatureAlgorithm -> Bool
+signatureCompatible (PubKeyRSA pk) (HashSHA1, SignatureRSA) = kxCanUseRSApkcs1 pk SHA1
+signatureCompatible (PubKeyRSA pk) (HashSHA256, SignatureRSA) = kxCanUseRSApkcs1 pk SHA256
+signatureCompatible (PubKeyRSA pk) (HashSHA384, SignatureRSA) = kxCanUseRSApkcs1 pk SHA384
+signatureCompatible (PubKeyRSA pk) (HashSHA512, SignatureRSA) = kxCanUseRSApkcs1 pk SHA512
+signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA256) = kxCanUseRSApss pk SHA256
+signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA384) = kxCanUseRSApss pk SHA384
+signatureCompatible (PubKeyRSA pk) (_, SignatureRSApssRSAeSHA512) = kxCanUseRSApss pk SHA512
+signatureCompatible (PubKeyDSA _) (_, SignatureDSA) = True
+signatureCompatible (PubKeyEC _) (_, SignatureECDSA) = True
+signatureCompatible (PubKeyEd25519 _) (_, SignatureEd25519) = True
+signatureCompatible (PubKeyEd448 _) (_, SignatureEd448) = True
+signatureCompatible _ (_, _) = False
 
-signatureHashData :: SignatureAlgorithm -> Maybe HashAlgorithm -> HashDescr
-signatureHashData SignatureRSA mhash =
-    case mhash of
-        Just HashSHA512 -> hashDescrSHA512
-        Just HashSHA256 -> hashDescrSHA256
-        Just HashSHA1   -> hashDescrSHA1
-        Nothing         -> HashDescr (hashFinal . hashUpdate (hashInit hashMD5SHA1)) id
-        _               -> error ("unimplemented signature hash type")
-signatureHashData SignatureDSS mhash =
-    case mhash of
-        Nothing       -> hashDescrSHA1
-        Just HashSHA1 -> hashDescrSHA1
-        Just _        -> error "invalid DSA hash choice, only SHA1 allowed"
-signatureHashData sig _ = error ("unimplemented signature type: " ++ show sig)
+-- Same as 'signatureCompatible' but for TLS13: for ECDSA this also checks the
+-- relation between hash in the HashAndSignatureAlgorithm and elliptic curve
+signatureCompatible13 :: PubKey -> HashAndSignatureAlgorithm -> Bool
+signatureCompatible13 (PubKeyEC ecPub) (h, SignatureECDSA) =
+    maybe False (\g -> findEllipticCurveGroup ecPub == Just g) (hashCurve h)
+  where
+    hashCurve HashSHA256 = Just P256
+    hashCurve HashSHA384 = Just P384
+    hashCurve HashSHA512 = Just P521
+    hashCurve _ = Nothing
+signatureCompatible13 pub hs = signatureCompatible pub hs
 
-signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm -> HashDescr -> Bytes -> IO DigitallySigned
-signatureCreate ctx malg hashMethod toSign = do
-    cc <- usingState_ ctx $ isClientContext
-    DigitallySigned malg <$> signRSA ctx cc hashMethod toSign
+-- | Translate a 'HashAndSignatureAlgorithm' to an acceptable 'CertificateType'.
+-- Perhaps this needs to take supported groups into account, so that, for
+-- example, if we don't support any shared ECDSA groups with the server, we
+-- return 'Nothing' rather than 'CertificateType_ECDSA_Sign'.
+--
+-- Therefore, this interface is preliminary.  It gets us moving in the right
+-- direction.  The interplay between all the various TLS extensions and
+-- certificate selection is rather complex.
+--
+-- The goal is to ensure that the client certificate request callback only sees
+-- 'CertificateType' values that are supported by the library and also
+-- compatible with the server signature algorithms extension.
+--
+-- Since we don't yet support ECDSA private keys, the caller will use
+-- 'lastSupportedCertificateType' to filter those out for now, leaving just
+-- @RSA@ as the only supported client certificate algorithm for TLS 1.3.
+--
+-- FIXME: Add RSA_PSS_PSS signatures when supported.
+hashSigToCertType :: HashAndSignatureAlgorithm -> Maybe CertificateType
+--
+hashSigToCertType (_, SignatureRSA) = Just CertificateType_RSA_Sign
+--
+hashSigToCertType (_, SignatureDSA) = Just CertificateType_DSA_Sign
+--
+hashSigToCertType (_, SignatureECDSA) = Just CertificateType_ECDSA_Sign
+--
+hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA256) =
+    Just CertificateType_RSA_Sign
+hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA384) =
+    Just CertificateType_RSA_Sign
+hashSigToCertType (HashIntrinsic, SignatureRSApssRSAeSHA512) =
+    Just CertificateType_RSA_Sign
+hashSigToCertType (HashIntrinsic, SignatureEd25519) =
+    Just CertificateType_Ed25519_Sign
+hashSigToCertType (HashIntrinsic, SignatureEd448) =
+    Just CertificateType_Ed448_Sign
+--
+hashSigToCertType _ = Nothing
 
-signatureVerify :: Context -> SignatureAlgorithm -> Bytes -> DigitallySigned -> IO Bool
-signatureVerify ctx sigAlgExpected toVerify digSig@(DigitallySigned hashSigAlg _) = do
+checkCertificateVerify
+    :: Context
+    -> Version
+    -> PubKey
+    -> ByteString
+    -> DigitallySigned
+    -> IO Bool
+checkCertificateVerify ctx usedVersion pubKey msgs digSig@(DigitallySigned hashSigAlg _)
+    | pubKey `signatureCompatible` hashSigAlg = doVerify
+    | otherwise = return False
+  where
+    doVerify =
+        prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs
+            >>= signatureVerifyWithCertVerifyData ctx digSig
+
+createCertificateVerify
+    :: Context
+    -> Version
+    -> PubKey
+    -> HashAndSignatureAlgorithm -- TLS12 only
+    -> ByteString
+    -> IO DigitallySigned
+createCertificateVerify ctx usedVersion pubKey hashSigAlg msgs =
+    prepareCertificateVerifySignatureData ctx usedVersion pubKey hashSigAlg msgs
+        >>= signatureCreateWithCertVerifyData ctx hashSigAlg
+
+type CertVerifyData = (SignatureParams, ByteString)
+
+-- in the case of TLS < 1.2, RSA signing, then the data need to be hashed first, as
+-- the SHA1_MD5 algorithm expect an already digested data
+buildVerifyData :: SignatureParams -> ByteString -> CertVerifyData
+buildVerifyData (RSAParams SHA1_MD5 enc) bs = (RSAParams SHA1_MD5 enc, hashFinal $ hashUpdate (hashInit SHA1_MD5) bs)
+buildVerifyData sigParam bs = (sigParam, bs)
+
+prepareCertificateVerifySignatureData
+    :: Context
+    -> Version
+    -> PubKey
+    -> HashAndSignatureAlgorithm -- TLS12 only
+    -> ByteString
+    -> IO CertVerifyData
+prepareCertificateVerifySignatureData _ctx _usedVersion pubKey hashSigAlg msgs =
+    return (signatureParams pubKey hashSigAlg, msgs)
+
+signatureParams :: PubKey -> HashAndSignatureAlgorithm -> SignatureParams
+signatureParams (PubKeyRSA _) hashSigAlg =
+    case hashSigAlg of
+        (HashSHA512, SignatureRSA) -> RSAParams SHA512 RSApkcs1
+        (HashSHA384, SignatureRSA) -> RSAParams SHA384 RSApkcs1
+        (HashSHA256, SignatureRSA) -> RSAParams SHA256 RSApkcs1
+        (HashSHA1, SignatureRSA) -> RSAParams SHA1 RSApkcs1
+        (HashIntrinsic, SignatureRSApssRSAeSHA512) -> RSAParams SHA512 RSApss
+        (HashIntrinsic, SignatureRSApssRSAeSHA384) -> RSAParams SHA384 RSApss
+        (HashIntrinsic, SignatureRSApssRSAeSHA256) -> RSAParams SHA256 RSApss
+        (hsh, SignatureRSA) -> error ("unimplemented RSA signature hash type: " ++ show hsh)
+        (_, sigAlg) ->
+            error ("signature algorithm is incompatible with RSA: " ++ show sigAlg)
+signatureParams (PubKeyDSA _) hashSigAlg =
+    case hashSigAlg of
+        (HashSHA1, SignatureDSA) -> DSAParams
+        (_, SignatureDSA) -> error "invalid DSA hash choice, only SHA1 allowed"
+        (_, sigAlg) ->
+            error ("signature algorithm is incompatible with DSA: " ++ show sigAlg)
+signatureParams (PubKeyEC _) hashSigAlg =
+    case hashSigAlg of
+        (HashSHA512, SignatureECDSA) -> ECDSAParams SHA512
+        (HashSHA384, SignatureECDSA) -> ECDSAParams SHA384
+        (HashSHA256, SignatureECDSA) -> ECDSAParams SHA256
+        (HashSHA1, SignatureECDSA) -> ECDSAParams SHA1
+        (hsh, SignatureECDSA) -> error ("unimplemented ECDSA signature hash type: " ++ show hsh)
+        (_, sigAlg) ->
+            error ("signature algorithm is incompatible with ECDSA: " ++ show sigAlg)
+signatureParams (PubKeyEd25519 _) hashSigAlg =
+    case hashSigAlg of
+        (HashIntrinsic, SignatureEd25519) -> Ed25519Params
+        (hsh, SignatureEd25519) -> error ("unimplemented Ed25519 signature hash type: " ++ show hsh)
+        (_, sigAlg) ->
+            error ("signature algorithm is incompatible with Ed25519: " ++ show sigAlg)
+signatureParams (PubKeyEd448 _) hashSigAlg =
+    case hashSigAlg of
+        (HashIntrinsic, SignatureEd448) -> Ed448Params
+        (hsh, SignatureEd448) -> error ("unimplemented Ed448 signature hash type: " ++ show hsh)
+        (_, sigAlg) ->
+            error ("signature algorithm is incompatible with Ed448: " ++ show sigAlg)
+signatureParams pk _ = error ("signatureParams: " ++ pubkeyType pk ++ " is not supported")
+
+signatureCreateWithCertVerifyData
+    :: Context
+    -> HashAndSignatureAlgorithm
+    -> CertVerifyData
+    -> IO DigitallySigned
+signatureCreateWithCertVerifyData ctx malg (sigParam, toSign) = do
+    role <- usingState_ ctx getRole
+    DigitallySigned malg <$> signPrivate ctx role sigParam toSign
+
+signatureVerify :: Context -> DigitallySigned -> PubKey -> ByteString -> IO Bool
+signatureVerify ctx digSig@(DigitallySigned hashSigAlg _) pubKey toVerifyData = do
     usedVersion <- usingState_ ctx getVersion
-    let hashDescr = case (usedVersion, hashSigAlg) of
-            (TLS12, Nothing)    -> error "expecting hash and signature algorithm in a TLS12 digitally signed structure"
-            (TLS12, Just (h,s)) | s == sigAlgExpected -> signatureHashData sigAlgExpected (Just h)
-                                | otherwise           -> error "expecting different signature algorithm"
-            (_,     Nothing)    -> signatureHashData sigAlgExpected Nothing
-            (_,     Just _)     -> error "not expecting hash and signature algorithm in a < TLS12 digitially signed structure"
-    signatureVerifyWithHashDescr ctx sigAlgExpected hashDescr toVerify digSig
+    let (sigParam, toVerify) =
+            case (usedVersion, hashSigAlg) of
+                (TLS12, hs)
+                    | pubKey `signatureCompatible` hs ->
+                        (signatureParams pubKey hashSigAlg, toVerifyData)
+                    | otherwise ->
+                        error "expecting different signature algorithm"
+                _ ->
+                    error
+                        "not expecting hash and signature algorithm in a < TLS12 digitially signed structure"
+    signatureVerifyWithCertVerifyData ctx digSig (sigParam, toVerify)
 
-signatureVerifyWithHashDescr :: Context
-                             -> SignatureAlgorithm
-                             -> HashDescr
-                             -> Bytes
-                             -> DigitallySigned
-                             -> IO Bool
-signatureVerifyWithHashDescr ctx sigAlgExpected hashDescr toVerify (DigitallySigned _ bs) = do
-    cc <- usingState_ ctx $ isClientContext
-    case sigAlgExpected of
-        SignatureRSA -> verifyRSA ctx cc hashDescr toVerify bs
-        SignatureDSS -> verifyRSA ctx cc hashDescr toVerify bs
-        _            -> error "not implemented yet"
+signatureVerifyWithCertVerifyData
+    :: Context
+    -> DigitallySigned
+    -> CertVerifyData
+    -> IO Bool
+signatureVerifyWithCertVerifyData ctx (DigitallySigned hs bs) (sigParam, toVerify) = do
+    checkSupportedHashSignature ctx hs
+    verifyPublic ctx sigParam toVerify bs
 
-generateSignedDHParams :: Context -> ServerDHParams -> IO Bytes
-generateSignedDHParams ctx serverParams = do
-    (cran, sran) <- usingHState ctx $ do
-                        (,) <$> gets hstClientRandom <*> (fromJust "server random" <$> gets hstServerRandom)
-    return $ encodeSignedDHParams cran sran serverParams
+digitallySignParams
+    :: Context
+    -> ByteString
+    -> PubKey
+    -> HashAndSignatureAlgorithm
+    -> IO DigitallySigned
+digitallySignParams ctx signatureData pubKey hashSigAlg =
+    let sigParam = signatureParams pubKey hashSigAlg
+     in signatureCreateWithCertVerifyData
+            ctx
+            hashSigAlg
+            (buildVerifyData sigParam signatureData)
+
+digitallySignDHParams
+    :: Context
+    -> ServerDHParams
+    -> PubKey
+    -> HashAndSignatureAlgorithm -- TLS12 only
+    -> IO DigitallySigned
+digitallySignDHParams ctx serverParams pubKey mhash = do
+    dhParamsData <-
+        withClientAndServerRandom ctx $ encodeSignedDHParams serverParams
+    digitallySignParams ctx dhParamsData pubKey mhash
+
+digitallySignECDHParams
+    :: Context
+    -> ServerECDHParams
+    -> PubKey
+    -> HashAndSignatureAlgorithm -- TLS12 only
+    -> IO DigitallySigned
+digitallySignECDHParams ctx serverParams pubKey mhash = do
+    ecdhParamsData <-
+        withClientAndServerRandom ctx $ encodeSignedECDHParams serverParams
+    digitallySignParams ctx ecdhParamsData pubKey mhash
+
+digitallySignDHParamsVerify
+    :: Context
+    -> ServerDHParams
+    -> PubKey
+    -> DigitallySigned
+    -> IO Bool
+digitallySignDHParamsVerify ctx dhparams pubKey signature = do
+    expectedData <- withClientAndServerRandom ctx $ encodeSignedDHParams dhparams
+    signatureVerify ctx signature pubKey expectedData
+
+digitallySignECDHParamsVerify
+    :: Context
+    -> ServerECDHParams
+    -> PubKey
+    -> DigitallySigned
+    -> IO Bool
+digitallySignECDHParamsVerify ctx dhparams pubKey signature = do
+    expectedData <- withClientAndServerRandom ctx $ encodeSignedECDHParams dhparams
+    signatureVerify ctx signature pubKey expectedData
+
+withClientAndServerRandom
+    :: Context -> (ClientRandom -> ServerRandom -> b) -> IO b
+withClientAndServerRandom ctx f = do
+    (cran, sran) <-
+        usingHState ctx $
+            (,)
+                <$> gets hstClientRandom
+                <*> (fromJust <$> gets hstServerRandom)
+    return $ f cran sran
+
+-- verify that the hash and signature selected by the peer is supported in
+-- the local configuration
+checkSupportedHashSignature
+    :: Context -> HashAndSignatureAlgorithm -> IO ()
+checkSupportedHashSignature ctx hs =
+    unless (hs `elem` supportedHashSignatures (ctxSupported ctx)) $
+        let msg = "unsupported hash and signature algorithm: " ++ show hs
+         in throwCore $ Error_Protocol msg IllegalParameter
diff --git a/Network/TLS/Handshake/State.hs b/Network/TLS/Handshake/State.hs
--- a/Network/TLS/Handshake/State.hs
+++ b/Network/TLS/Handshake/State.hs
@@ -1,262 +1,569 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE CPP #-}
--- |
--- Module      : Network.TLS.Handshake.State
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Handshake.State
-    ( HandshakeState(..)
-    , ClientCertRequestData
-    , HandshakeM
-    , newEmptyHandshake
-    , runHandshake
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.State (
+    HandshakeState (..),
+    TransHashState (..),
+    HandshakeMode13 (..),
+    RTT0Status (..),
+    CertReqCBdata,
+    HandshakeM,
+    newEmptyHandshake,
+    runHandshake,
+
     -- * key accessors
-    , setPublicKey
-    , setPrivateKey
-    , getLocalPrivateKey
-    , getRemotePublicKey
-    , setServerDHParams
+    setPublicKey,
+    setPublicPrivateKeys,
+    getLocalPublicPrivateKeys,
+    getRemotePublicKey,
+    setServerDHParams,
+    getServerDHParams,
+    setServerECDHParams,
+    getServerECDHParams,
+    setDHPrivate,
+    getDHPrivate,
+    setGroupPrivate,
+    getGroupPrivate,
+
     -- * cert accessors
-    , setClientCertSent
-    , getClientCertSent
-    , setCertReqSent
-    , getCertReqSent
-    , setClientCertChain
-    , getClientCertChain
-    , setClientCertRequest
-    , getClientCertRequest
+    setClientRandom,
+    getClientRandom,
+    setOuterClientRandom,
+    getOuterClientRandom,
+    setClientHello,
+    getClientHello,
+    setECHEE,
+    getECHEE,
+    setECHAccepted,
+    getECHAccepted,
+    setClientCertSent,
+    getClientCertSent,
+    setCertReqSent,
+    getCertReqSent,
+    setClientCertChain,
+    getClientCertChain,
+    setCertReqToken,
+    getCertReqToken,
+    setCertReqCBdata,
+    getCertReqCBdata,
+    setCertReqSigAlgsCert,
+    getCertReqSigAlgsCert,
+
     -- * digest accessors
-    , addHandshakeMessage
-    , updateHandshakeDigest
-    , getHandshakeMessages
-    , getHandshakeDigest
-    -- * master secret
-    , setMasterSecret
-    , setMasterSecretFromPre
+    addHandshakeMessage,
+    getHandshakeMessages,
+
+    -- * main secret
+    setMainSecret,
+    setMainSecretFromPre,
+
     -- * misc accessor
-    , getPendingCipher
-    , setServerHelloParameters
-    ) where
+    getPendingCipher,
+    setExtendedMainSecret,
+    getExtendedMainSecret,
+    setSupportedGroup,
+    getSupportedGroup,
+    setTLS13HandshakeMode,
+    getTLS13HandshakeMode,
+    setTLS13RTT0Status,
+    getTLS13RTT0Status,
+    setTLS13EarlySecret,
+    getTLS13EarlySecret,
+    setTLS13ResumptionSecret,
+    getTLS13ResumptionSecret,
+    setTLS13CertComp,
+    getTLS13CertComp,
+    setCCS13Sent,
+    getCCS13Sent,
+    setCCS13Recv,
+    getCCS13Recv,
+) where
 
-import Network.TLS.Util
-import Network.TLS.Struct
-import Network.TLS.Record.State
-import Network.TLS.Packet
-import Network.TLS.Crypto
+import Control.Monad.State.Strict
+import Data.ByteArray (convert)
+import Data.X509 (CertificateChain)
+
 import Network.TLS.Cipher
 import Network.TLS.Compression
+import Network.TLS.Crypto
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Record.State
+import Network.TLS.Struct
 import Network.TLS.Types
-import Control.Applicative (Applicative, (<$>))
-import Control.Monad.State
-import Data.X509 (CertificateChain)
+import Network.TLS.Util
 
 data HandshakeKeyState = HandshakeKeyState
-    { hksRemotePublicKey :: !(Maybe PubKey)
-    , hksLocalPrivateKey :: !(Maybe PrivKey)
-    } deriving (Show)
+    { hksRemotePublicKey :: Maybe PubKey
+    , hksLocalPublicPrivateKeys :: Maybe (PubKey, PrivKey)
+    }
+    deriving (Show)
 
+data TransHashState
+    = -- | Initial state
+      TransHashState0
+    | -- | A raw CH is stored since hash algo is not chosen yet.
+      TransHashState1 [ByteString]
+    | -- | Hashed
+      TransHashState2 HashCtx
+
+{- FOURMOLU_DISABLE -}
+instance Show TransHashState where
+    show  TransHashState0       = "State0 "
+    show (TransHashState1 _)    = "State1 CH"
+    show (TransHashState2 hctx) = showBytesHex $ hashFinal hctx
+{- FOURMOLU_ENABLE -}
+
 data HandshakeState = HandshakeState
-    { hstClientVersion       :: !(Version)
-    , hstClientRandom        :: !ClientRandom
-    , hstServerRandom        :: !(Maybe ServerRandom)
-    , hstMasterSecret        :: !(Maybe Bytes)
-    , hstKeyState            :: !HandshakeKeyState
-    , hstServerDHParams      :: !(Maybe ServerDHParams)
-    , hstDHPrivate           :: !(Maybe DHPrivate)
-    , hstHandshakeDigest     :: !(Either [Bytes] HashCtx)
-    , hstHandshakeMessages   :: [Bytes]
-    , hstClientCertRequest   :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
-    , hstClientCertSent      :: !Bool -- ^ Set to true when a client certificate chain was sent
-    , hstCertReqSent         :: !Bool -- ^ Set to true when a certificate request was sent
-    , hstClientCertChain     :: !(Maybe CertificateChain)
-    , hstPendingTxState      :: Maybe RecordState
-    , hstPendingRxState      :: Maybe RecordState
-    , hstPendingCipher       :: Maybe Cipher
-    , hstPendingCompression  :: Compression
-    } deriving (Show)
+    { hstClientVersion :: Version
+    , hstClientRandom :: ClientRandom
+    -- ^ For ECH, inner client random.
+    , hstServerRandom :: Maybe ServerRandom
+    , hstMainSecret :: Maybe Secret
+    , hstKeyState :: HandshakeKeyState
+    , hstServerDHParams :: Maybe ServerDHParams
+    , hstDHPrivate :: Maybe DHPrivate
+    , hstServerECDHParams :: Maybe ServerECDHParams
+    , hstGroupPrivate :: [(Group, GroupPrivate)]
+    , hstTransHashState :: TransHashState
+    , hstTransHashStateI :: TransHashState -- Inner CH for client ECH
+    , hstHandshakeMessages :: [ByteString]
+    -- ^ To create certificate verify for TLS 1.2.
+    --   This should be removed when TLS 1.2 is dropped.
+    , hstCertReqToken :: Maybe ByteString
+    -- ^ Set to Just-value when a TLS13 certificate request is received
+    , hstCertReqCBdata :: Maybe CertReqCBdata
+    -- ^ Set to Just-value when a certificate request is received
+    , hstCertReqSigAlgsCert :: Maybe [HashAndSignatureAlgorithm]
+    -- ^ In TLS 1.3, these are separate from the certificate
+    -- issuer signature algorithm hints in the callback data.
+    -- In TLS 1.2 the same list is overloaded for both purposes.
+    -- Not present in TLS 1.1 and earlier
+    , hstClientCertSent :: Bool
+    -- ^ Set to true when a client certificate chain was sent
+    , hstCertReqSent :: Bool
+    -- ^ Set to true when a certificate request was sent.  This applies
+    -- only to requests sent during handshake (not post-handshake).
+    , hstClientCertChain :: Maybe CertificateChain
+    , hstPendingTxState :: Maybe RecordState
+    , hstPendingRxState :: Maybe RecordState
+    , hstPendingCipher :: Maybe Cipher
+    , hstPendingCompression :: Compression
+    , hstExtendedMainSecret :: Bool
+    , hstSupportedGroup :: Maybe Group
+    , hstTLS13HandshakeMode :: HandshakeMode13
+    , hstTLS13RTT0Status :: RTT0Status
+    , hstTLS13EarlySecret :: Maybe (BaseSecret EarlySecret) -- xxx
+    , hstTLS13ResumptionSecret :: Maybe (BaseSecret ResumptionSecret)
+    , hstTLS13CertComp :: Bool
+    , hstCCS13Sent :: Bool
+    , hstCCS13Recv :: Bool
+    , hstTLS13OuterClientRandom :: Maybe ClientRandom
+    -- ^ Used for key logging in the case of ECH.
+    , hstTLS13ClientHello :: Maybe (ClientHello, [ByteString])
+    -- ^ Inner client hello in the case of ECH.
+    , hstTLS13ECHAccepted :: Bool
+    , hstTLS13ECHEE :: Bool
+    }
+    deriving (Show)
 
-type ClientCertRequestData = ([CertificateType],
-                              Maybe [(HashAlgorithm, SignatureAlgorithm)],
-                              [DistinguishedName])
+-- | When we receive a CertificateRequest from a server, a just-in-time
+--    callback is issued to the application to obtain a suitable certificate.
+--    Somewhat unfortunately, the callback parameters don't abstract away the
+--    details of the TLS 1.2 Certificate Request message, which combines the
+--    legacy @certificate_types@ and new @supported_signature_algorithms@
+--    parameters is a rather subtle way.
+--
+--    TLS 1.2 also (again unfortunately, in the opinion of the author of this
+--    comment) overloads the signature algorithms parameter to constrain not only
+--    the algorithms used in TLS, but also the algorithms used by issuing CAs in
+--    the X.509 chain.  Best practice is to NOT treat such that restriction as a
+--    MUST, but rather take it as merely a preference, when a choice exists.  If
+--    the best chain available does not match the provided signature algorithm
+--    list, go ahead and use it anyway, it will probably work, and the server may
+--    not even care about the issuer CAs at all, it may be doing DANE or have
+--    explicit mappings for the client's public key, ...
+--
+--    The TLS 1.3 @CertificateRequest@ message, drops @certificate_types@ and no
+--    longer overloads @supported_signature_algorithms@ to cover X.509.  It also
+--    includes a new opaque context token that the client must echo back, which
+--    makes certain client authentication replay attacks more difficult.  We will
+--    store that context separately, it does not need to be presented in the user
+--    callback.  The certificate signature algorithms preferred by the peer are
+--    now in the separate @signature_algorithms_cert@ extension, but we cannot
+--    report these to the application callback without an API change.  The good
+--    news is that filtering the X.509 signature types is generally unnecessary,
+--    unwise and difficult.  So we just ignore this extension.
+--
+--    As a result, the information we provide to the callback is no longer a
+--    verbatim copy of the certificate request payload.  In the case of TLS 1.3
+--    The 'CertificateType' list is synthetically generated from the server's
+--    @signature_algorithms@ extension, and the @signature_algorithms_certs@
+--    extension is ignored.
+--
+--    Since the original TLS 1.2 'CertificateType' has no provision for the newer
+--    certificate types that have appeared in TLS 1.3 we're adding some synthetic
+--    values that have no equivalent values in the TLS 1.2 'CertificateType' as
+--    defined in the IANA
+--    <https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-parameters-2
+--    TLS ClientCertificateType Identifiers> registry.  These values are inferred
+--    from the TLS 1.3 @signature_algorithms@ extension, and will allow clients to
+--    present Ed25519 and Ed448 certificates when these become supported.
+type CertReqCBdata =
+    ( [CertificateType]
+    , Maybe [HashAndSignatureAlgorithm]
+    , [DistinguishedName]
+    )
 
-newtype HandshakeM a = HandshakeM { runHandshakeM :: State HandshakeState a }
+newtype HandshakeM a = HandshakeM {runHandshakeM :: State HandshakeState a}
     deriving (Functor, Applicative, Monad)
 
 instance MonadState HandshakeState HandshakeM where
     put x = HandshakeM (put x)
-    get   = HandshakeM (get)
-#if MIN_VERSION_mtl(2,1,0)
+    get = HandshakeM get
     state f = HandshakeM (state f)
-#endif
 
 -- create a new empty handshake state
 newEmptyHandshake :: Version -> ClientRandom -> HandshakeState
-newEmptyHandshake ver crand = HandshakeState
-    { hstClientVersion       = ver
-    , hstClientRandom        = crand
-    , hstServerRandom        = Nothing
-    , hstMasterSecret        = Nothing
-    , hstKeyState            = HandshakeKeyState Nothing Nothing
-    , hstServerDHParams      = Nothing
-    , hstDHPrivate           = Nothing
-    , hstHandshakeDigest     = Left []
-    , hstHandshakeMessages   = []
-    , hstClientCertRequest   = Nothing
-    , hstClientCertSent      = False
-    , hstCertReqSent         = False
-    , hstClientCertChain     = Nothing
-    , hstPendingTxState      = Nothing
-    , hstPendingRxState      = Nothing
-    , hstPendingCipher       = Nothing
-    , hstPendingCompression  = nullCompression
-    }
+newEmptyHandshake ver crand =
+    HandshakeState
+        { hstClientVersion = ver
+        , hstClientRandom = crand
+        , hstServerRandom = Nothing
+        , hstMainSecret = Nothing
+        , hstKeyState = HandshakeKeyState Nothing Nothing
+        , hstServerDHParams = Nothing
+        , hstDHPrivate = Nothing
+        , hstServerECDHParams = Nothing
+        , hstGroupPrivate = []
+        , hstTransHashState = TransHashState0
+        , hstTransHashStateI = TransHashState0
+        , hstHandshakeMessages = []
+        , hstCertReqToken = Nothing
+        , hstCertReqCBdata = Nothing
+        , hstCertReqSigAlgsCert = Nothing
+        , hstClientCertSent = False
+        , hstCertReqSent = False
+        , hstClientCertChain = Nothing
+        , hstPendingTxState = Nothing
+        , hstPendingRxState = Nothing
+        , hstPendingCipher = Nothing
+        , hstPendingCompression = nullCompression
+        , hstExtendedMainSecret = False
+        , hstSupportedGroup = Nothing
+        , hstTLS13HandshakeMode = FullHandshake
+        , hstTLS13RTT0Status = RTT0None
+        , hstTLS13EarlySecret = Nothing
+        , hstTLS13ResumptionSecret = Nothing
+        , hstTLS13CertComp = False
+        , hstCCS13Sent = False
+        , hstCCS13Recv = False
+        , hstTLS13OuterClientRandom = Nothing
+        , hstTLS13ClientHello = Nothing
+        , hstTLS13ECHAccepted = False
+        , hstTLS13ECHEE = False
+        }
 
 runHandshake :: HandshakeState -> HandshakeM a -> (a, HandshakeState)
 runHandshake hst f = runState (runHandshakeM f) hst
 
 setPublicKey :: PubKey -> HandshakeM ()
-setPublicKey pk = modify (\hst -> hst { hstKeyState = setPK (hstKeyState hst) })
-  where setPK hks = hks { hksRemotePublicKey = Just pk }
+setPublicKey pk = modify' (\hst -> hst{hstKeyState = setPK (hstKeyState hst)})
+  where
+    setPK hks = hks{hksRemotePublicKey = Just pk}
 
-setPrivateKey :: PrivKey -> HandshakeM ()
-setPrivateKey pk = modify (\hst -> hst { hstKeyState = setPK (hstKeyState hst) })
-  where setPK hks = hks { hksLocalPrivateKey = Just pk }
+setPublicPrivateKeys :: (PubKey, PrivKey) -> HandshakeM ()
+setPublicPrivateKeys keys = modify' (\hst -> hst{hstKeyState = setKeys (hstKeyState hst)})
+  where
+    setKeys hks = hks{hksLocalPublicPrivateKeys = Just keys}
 
 getRemotePublicKey :: HandshakeM PubKey
-getRemotePublicKey = fromJust "remote public key" <$> gets (hksRemotePublicKey . hstKeyState)
+getRemotePublicKey = fromJust <$> gets (hksRemotePublicKey . hstKeyState)
 
-getLocalPrivateKey :: HandshakeM PrivKey
-getLocalPrivateKey = fromJust "local private key" <$> gets (hksLocalPrivateKey . hstKeyState)
+getLocalPublicPrivateKeys :: HandshakeM (PubKey, PrivKey)
+getLocalPublicPrivateKeys =
+    fromJust <$> gets (hksLocalPublicPrivateKeys . hstKeyState)
 
 setServerDHParams :: ServerDHParams -> HandshakeM ()
-setServerDHParams shp = modify (\hst -> hst { hstServerDHParams = Just shp })
+setServerDHParams shp = modify' (\hst -> hst{hstServerDHParams = Just shp})
 
+getServerDHParams :: HandshakeM ServerDHParams
+getServerDHParams = fromJust <$> gets hstServerDHParams
+
+setServerECDHParams :: ServerECDHParams -> HandshakeM ()
+setServerECDHParams shp = modify' (\hst -> hst{hstServerECDHParams = Just shp})
+
+getServerECDHParams :: HandshakeM ServerECDHParams
+getServerECDHParams = fromJust <$> gets hstServerECDHParams
+
+setDHPrivate :: DHPrivate -> HandshakeM ()
+setDHPrivate shp = modify' (\hst -> hst{hstDHPrivate = Just shp})
+
+getDHPrivate :: HandshakeM DHPrivate
+getDHPrivate = fromJust <$> gets hstDHPrivate
+
+getGroupPrivate :: HandshakeM [(Group, GroupPrivate)]
+getGroupPrivate = gets hstGroupPrivate
+
+setGroupPrivate :: [(Group, GroupPrivate)] -> HandshakeM ()
+setGroupPrivate shp = modify' (\hst -> hst{hstGroupPrivate = shp})
+
+setExtendedMainSecret :: Bool -> HandshakeM ()
+setExtendedMainSecret b = modify' (\hst -> hst{hstExtendedMainSecret = b})
+
+getExtendedMainSecret :: HandshakeM Bool
+getExtendedMainSecret = gets hstExtendedMainSecret
+
+setSupportedGroup :: Group -> HandshakeM ()
+setSupportedGroup g = modify' (\hst -> hst{hstSupportedGroup = Just g})
+
+getSupportedGroup :: HandshakeM (Maybe Group)
+getSupportedGroup = gets hstSupportedGroup
+
+-- | Type to show which handshake mode is used in TLS 1.3.
+data HandshakeMode13
+    = -- | Full handshake is used.
+      FullHandshake
+    | -- | Full handshake is used with hello retry request.
+      HelloRetryRequest
+    | -- | Server authentication is skipped.
+      PreSharedKey
+    | -- | Server authentication is skipped and early data is sent.
+      RTT0
+    deriving (Show, Eq)
+
+setTLS13HandshakeMode :: HandshakeMode13 -> HandshakeM ()
+setTLS13HandshakeMode s = modify' (\hst -> hst{hstTLS13HandshakeMode = s})
+
+getTLS13HandshakeMode :: HandshakeM HandshakeMode13
+getTLS13HandshakeMode = gets hstTLS13HandshakeMode
+
+data RTT0Status
+    = RTT0None
+    | RTT0Sent
+    | RTT0Accepted
+    | RTT0Rejected
+    deriving (Show, Eq)
+
+setTLS13RTT0Status :: RTT0Status -> HandshakeM ()
+setTLS13RTT0Status s = modify' (\hst -> hst{hstTLS13RTT0Status = s})
+
+getTLS13RTT0Status :: HandshakeM RTT0Status
+getTLS13RTT0Status = gets hstTLS13RTT0Status
+
+setTLS13EarlySecret :: BaseSecret EarlySecret -> HandshakeM ()
+setTLS13EarlySecret secret = modify' (\hst -> hst{hstTLS13EarlySecret = Just secret})
+
+getTLS13EarlySecret :: HandshakeM (Maybe (BaseSecret EarlySecret))
+getTLS13EarlySecret = gets hstTLS13EarlySecret
+
+setTLS13ResumptionSecret :: BaseSecret ResumptionSecret -> HandshakeM ()
+setTLS13ResumptionSecret secret = modify' (\hst -> hst{hstTLS13ResumptionSecret = Just secret})
+
+getTLS13ResumptionSecret :: HandshakeM (Maybe (BaseSecret ResumptionSecret))
+getTLS13ResumptionSecret = gets hstTLS13ResumptionSecret
+
+setTLS13CertComp :: Bool -> HandshakeM ()
+setTLS13CertComp comp = modify' (\hst -> hst{hstTLS13CertComp = comp})
+
+getTLS13CertComp :: HandshakeM Bool
+getTLS13CertComp = gets hstTLS13CertComp
+
+setCCS13Sent :: Bool -> HandshakeM ()
+setCCS13Sent sent = modify' (\hst -> hst{hstCCS13Sent = sent})
+
+getCCS13Sent :: HandshakeM Bool
+getCCS13Sent = gets hstCCS13Sent
+
+setCCS13Recv :: Bool -> HandshakeM ()
+setCCS13Recv sent = modify' (\hst -> hst{hstCCS13Recv = sent})
+
+getCCS13Recv :: HandshakeM Bool
+getCCS13Recv = gets hstCCS13Recv
+
 setCertReqSent :: Bool -> HandshakeM ()
-setCertReqSent b = modify (\hst -> hst { hstCertReqSent = b })
+setCertReqSent b = modify' (\hst -> hst{hstCertReqSent = b})
 
 getCertReqSent :: HandshakeM Bool
 getCertReqSent = gets hstCertReqSent
 
 setClientCertSent :: Bool -> HandshakeM ()
-setClientCertSent b = modify (\hst -> hst { hstClientCertSent = b })
+setClientCertSent b = modify' (\hst -> hst{hstClientCertSent = b})
 
+getClientRandom :: HandshakeM ClientRandom
+getClientRandom = gets hstClientRandom
+
+setClientRandom :: ClientRandom -> HandshakeM ()
+setClientRandom cr = modify' $ \hst -> hst{hstClientRandom = cr}
+
+getOuterClientRandom :: HandshakeM (Maybe ClientRandom)
+getOuterClientRandom = gets hstTLS13OuterClientRandom
+
+setOuterClientRandom :: Maybe ClientRandom -> HandshakeM ()
+setOuterClientRandom mcr = modify' (\hst -> hst{hstTLS13OuterClientRandom = mcr})
+
+getClientHello :: HandshakeM (Maybe (ClientHello, [ByteString]))
+getClientHello = gets hstTLS13ClientHello
+
+setClientHello :: ClientHello -> [ByteString] -> HandshakeM ()
+setClientHello ch b = modify' $ \hst -> hst{hstTLS13ClientHello = Just (ch, b)}
+
+getECHAccepted :: HandshakeM Bool
+getECHAccepted = gets hstTLS13ECHAccepted
+
+setECHAccepted :: Bool -> HandshakeM ()
+setECHAccepted b = modify' $ \hst -> hst{hstTLS13ECHAccepted = b}
+
+getECHEE :: HandshakeM Bool
+getECHEE = gets hstTLS13ECHEE
+
+setECHEE :: Bool -> HandshakeM ()
+setECHEE b = modify' $ \hst -> hst{hstTLS13ECHEE = b}
+
 getClientCertSent :: HandshakeM Bool
 getClientCertSent = gets hstClientCertSent
 
 setClientCertChain :: CertificateChain -> HandshakeM ()
-setClientCertChain b = modify (\hst -> hst { hstClientCertChain = Just b })
+setClientCertChain b = modify' (\hst -> hst{hstClientCertChain = Just b})
 
 getClientCertChain :: HandshakeM (Maybe CertificateChain)
 getClientCertChain = gets hstClientCertChain
 
-setClientCertRequest :: ClientCertRequestData -> HandshakeM ()
-setClientCertRequest d = modify (\hst -> hst { hstClientCertRequest = Just d })
+--
+setCertReqToken :: Maybe ByteString -> HandshakeM ()
+setCertReqToken token = modify' $ \hst -> hst{hstCertReqToken = token}
 
-getClientCertRequest :: HandshakeM (Maybe ClientCertRequestData)
-getClientCertRequest = gets hstClientCertRequest
+getCertReqToken :: HandshakeM (Maybe ByteString)
+getCertReqToken = gets hstCertReqToken
 
+--
+setCertReqCBdata :: Maybe CertReqCBdata -> HandshakeM ()
+setCertReqCBdata d = modify' (\hst -> hst{hstCertReqCBdata = d})
+
+getCertReqCBdata :: HandshakeM (Maybe CertReqCBdata)
+getCertReqCBdata = gets hstCertReqCBdata
+
+-- Dead code, until we find some use for the extension
+setCertReqSigAlgsCert :: Maybe [HashAndSignatureAlgorithm] -> HandshakeM ()
+setCertReqSigAlgsCert as = modify' $ \hst -> hst{hstCertReqSigAlgsCert = as}
+
+getCertReqSigAlgsCert :: HandshakeM (Maybe [HashAndSignatureAlgorithm])
+getCertReqSigAlgsCert = gets hstCertReqSigAlgsCert
+
+--
 getPendingCipher :: HandshakeM Cipher
-getPendingCipher = fromJust "pending cipher" <$> gets hstPendingCipher
+getPendingCipher = fromJust <$> gets hstPendingCipher
 
-addHandshakeMessage :: Bytes -> HandshakeM ()
-addHandshakeMessage content = modify $ \hs -> hs { hstHandshakeMessages = content : hstHandshakeMessages hs}
+addHandshakeMessage :: ByteString -> HandshakeM ()
+addHandshakeMessage content = modify' $ \hs -> hs{hstHandshakeMessages = content : hstHandshakeMessages hs}
 
-getHandshakeMessages :: HandshakeM [Bytes]
+getHandshakeMessages :: HandshakeM [ByteString]
 getHandshakeMessages = gets (reverse . hstHandshakeMessages)
 
-updateHandshakeDigest :: Bytes -> HandshakeM ()
-updateHandshakeDigest content = modify $ \hs -> hs
-    { hstHandshakeDigest = case hstHandshakeDigest hs of
-                                Left bytes    -> Left (content:bytes)
-                                Right hashCtx -> Right $ hashUpdate hashCtx content }
-
-getHandshakeDigest :: Version -> Role -> HandshakeM Bytes
-getHandshakeDigest ver role = gets gen
-  where gen hst = case hstHandshakeDigest hst of
-                      Right hashCtx ->
-                         let msecret = fromJust "master secret" $ hstMasterSecret hst
-                          in generateFinish ver msecret hashCtx
-                      Left _        ->
-                         error "un-initialized handshake digest"
-        generateFinish | role == ClientRole = generateClientFinished
-                       | otherwise          = generateServerFinished
+-- | Generate the main secret from the pre-main secret.
+setMainSecretFromPre
+    :: Version
+    -- ^ chosen transmission version
+    -> Role
+    -- ^ the role (Client or Server) of the generating side
+    -> Secret
+    -- ^ the pre-main secret
+    -> HandshakeM Secret
+setMainSecretFromPre ver role preMainSecret = do
+    ems <- getExtendedMainSecret
+    secret <- if ems then get >>= genExtendedSecret else genSecret <$> get
+    setMainSecret ver role secret
+    return secret
+  where
+    genSecret hst =
+        generateMainSecret
+            ver
+            (fromJust $ hstPendingCipher hst)
+            preMainSecret
+            (hstClientRandom hst)
+            (fromJust $ hstServerRandom hst)
+    genExtendedSecret hst =
+        generateExtendedMainSecret
+            ver
+            (fromJust $ hstPendingCipher hst)
+            preMainSecret
+            <$> getSessionHash
 
--- | Generate the master secret from the pre master secret.
-setMasterSecretFromPre :: Version -- ^ chosen transmission version
-                       -> Role    -- ^ the role (Client or Server) of the generating side
-                       -> Bytes   -- ^ the pre master secret
-                       -> HandshakeM ()
-setMasterSecretFromPre ver role premasterSecret = do
-    secret <- genSecret <$> get
-    setMasterSecret ver role secret
-  where genSecret hst = generateMasterSecret ver
-                                 premasterSecret
-                                 (hstClientRandom hst)
-                                 (fromJust "server random" $ hstServerRandom hst)
+getSessionHash :: HandshakeM ByteString
+getSessionHash = gets $ \hst ->
+    case hstTransHashState hst of
+        TransHashState2 hashCtx -> hashFinal hashCtx
+        _ -> error "un-initialized session hash"
 
--- | Set master secret and as a side effect generate the key block
+-- | Set main secret and as a side effect generate the key block
 -- with all the right parameters, and setup the pending tx/rx state.
-setMasterSecret :: Version -> Role -> Bytes -> HandshakeM ()
-setMasterSecret ver role masterSecret = modify $ \hst ->
-    let (pendingTx, pendingRx) = computeKeyBlock hst masterSecret ver role
-     in hst { hstMasterSecret   = Just masterSecret
+setMainSecret :: Version -> Role -> Secret -> HandshakeM ()
+setMainSecret ver role mainSecret = modify' $ \hst ->
+    let (pendingTx, pendingRx) = computeKeyBlock hst mainSecret ver role
+     in hst
+            { hstMainSecret = Just mainSecret
             , hstPendingTxState = Just pendingTx
-            , hstPendingRxState = Just pendingRx }
+            , hstPendingRxState = Just pendingRx
+            }
 
-computeKeyBlock :: HandshakeState -> Bytes -> Version -> Role -> (RecordState, RecordState)
-computeKeyBlock hst masterSecret ver cc = (pendingTx, pendingRx)
-  where cipher       = fromJust "cipher" $ hstPendingCipher hst
-        keyblockSize = cipherKeyBlockSize cipher
+computeKeyBlock
+    :: HandshakeState -> Secret -> Version -> Role -> (RecordState, RecordState)
+computeKeyBlock hst mainSecret ver cc = (pendingTx, pendingRx)
+  where
+    cipher = fromJust $ hstPendingCipher hst
+    keyblockSize = cipherKeyBlockSize cipher
 
-        bulk         = cipherBulk cipher
-        digestSize   = hashSize $ cipherHash cipher
-        keySize      = bulkKeySize bulk
-        ivSize       = bulkIVSize bulk
-        kb           = generateKeyBlock ver (hstClientRandom hst)
-                                        (fromJust "server random" $ hstServerRandom hst)
-                                        masterSecret keyblockSize
+    bulk = cipherBulk cipher
+    digestSize =
+        if hasMAC (bulkF bulk)
+            then hashDigestSize (cipherHash cipher)
+            else 0
+    keySize = bulkKeySize bulk
+    ivSize = bulkIVSize bulk
+    kb =
+        generateKeyBlock
+            ver
+            cipher
+            (hstClientRandom hst)
+            (fromJust $ hstServerRandom hst)
+            mainSecret
+            keyblockSize
 
-        (cMACSecret, sMACSecret, cWriteKey, sWriteKey, cWriteIV, sWriteIV) =
-                    fromJust "p6" $ partition6 kb (digestSize, digestSize, keySize, keySize, ivSize, ivSize)
+    (cMACSecret, sMACSecret, cWriteKey, sWriteKey, cWriteIV, sWriteIV) =
+        fromJust $
+            partition6 kb (digestSize, digestSize, keySize, keySize, ivSize, ivSize)
 
-        cstClient = CryptState { cstKey        = cWriteKey
-                               , cstIV         = cWriteIV
-                               , cstMacSecret  = cMACSecret }
-        cstServer = CryptState { cstKey        = sWriteKey
-                               , cstIV         = sWriteIV
-                               , cstMacSecret  = sMACSecret }
-        msClient = MacState { msSequence = 0 }
-        msServer = MacState { msSequence = 0 }
+    cstClient =
+        CryptState
+            { cstKey = bulkInit bulk (BulkEncrypt `orOnServer` BulkDecrypt) cWriteKey
+            , cstIV = convert $ cWriteIV
+            , cstMacSecret = cMACSecret
+            }
+    cstServer =
+        CryptState
+            { cstKey = bulkInit bulk (BulkDecrypt `orOnServer` BulkEncrypt) sWriteKey
+            , cstIV = convert $ sWriteIV
+            , cstMacSecret = sMACSecret
+            }
+    msClient = MacState{msSequence = 0}
+    msServer = MacState{msSequence = 0}
 
-        pendingTx = RecordState
-                  { stCryptState  = if cc == ClientRole then cstClient else cstServer
-                  , stMacState    = if cc == ClientRole then msClient else msServer
-                  , stCipher      = Just cipher
-                  , stCompression = hstPendingCompression hst
-                  }
-        pendingRx = RecordState
-                  { stCryptState  = if cc == ClientRole then cstServer else cstClient
-                  , stMacState    = if cc == ClientRole then msServer else msClient
-                  , stCipher      = Just cipher
-                  , stCompression = hstPendingCompression hst
-                  }
+    pendingTx =
+        RecordState
+            { stCryptState = if cc == ClientRole then cstClient else cstServer
+            , stMacState = if cc == ClientRole then msClient else msServer
+            , stCryptLevel = CryptMainSecret
+            , stCipher = Just cipher
+            , stCompression = hstPendingCompression hst
+            }
+    pendingRx =
+        RecordState
+            { stCryptState = if cc == ClientRole then cstServer else cstClient
+            , stMacState = if cc == ClientRole then msServer else msClient
+            , stCryptLevel = CryptMainSecret
+            , stCipher = Just cipher
+            , stCompression = hstPendingCompression hst
+            }
 
-setServerHelloParameters :: Version      -- ^ chosen version
-                         -> ServerRandom
-                         -> Cipher
-                         -> Compression
-                         -> HandshakeM ()
-setServerHelloParameters ver sran cipher compression = do
-    modify $ \hst -> hst
-                { hstServerRandom       = Just sran
-                , hstPendingCipher      = Just cipher
-                , hstPendingCompression = compression
-                , hstHandshakeDigest    = updateDigest $ hstHandshakeDigest hst
-                }
-  where initCtx = if ver < TLS12 then hashMD5SHA1 else hashSHA256
-        updateDigest (Left bytes) = Right $ foldl hashUpdate initCtx $ reverse bytes
-        updateDigest (Right _)    = error "cannot initialize digest with another digest"
+    orOnServer f g = if cc == ClientRole then f else g
diff --git a/Network/TLS/Handshake/State13.hs b/Network/TLS/Handshake/State13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/State13.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.State13 (
+    CryptLevel (
+        CryptEarlySecret,
+        CryptHandshakeSecret,
+        CryptApplicationSecret
+    ),
+    TrafficSecret,
+    getTxRecordState,
+    getRxRecordState,
+    setTxRecordState,
+    setRxRecordState,
+    getTxLevel,
+    getRxLevel,
+    clearTxRecordState,
+    clearRxRecordState,
+    PendingRecvAction (..),
+    setPendingRecvActions,
+    popPendingRecvAction,
+) where
+
+import Control.Concurrent.MVar
+import Data.IORef
+
+import Network.TLS.Cipher
+import Network.TLS.Compression
+import Network.TLS.Context.Internal
+import Network.TLS.Imports
+import Network.TLS.KeySchedule (hkdfExpandLabel)
+import Network.TLS.Record.State
+import Network.TLS.Types
+
+getTxRecordState :: Context -> IO (Hash, Cipher, CryptLevel, Secret)
+getTxRecordState ctx = getXState ctx ctxTxRecordState
+
+getRxRecordState :: Context -> IO (Hash, Cipher, CryptLevel, Secret)
+getRxRecordState ctx = getXState ctx ctxRxRecordState
+
+getXState
+    :: Context
+    -> (Context -> MVar RecordState)
+    -> IO (Hash, Cipher, CryptLevel, Secret)
+getXState ctx func = do
+    tx <- readMVar (func ctx)
+    let usedCipher = fromJust $ stCipher tx
+        usedHash = cipherHash usedCipher
+        level = stCryptLevel tx
+        secret = cstMacSecret $ stCryptState tx
+    return (usedHash, usedCipher, level, secret)
+
+-- In the case of QUIC, stCipher is Nothing.
+-- So, fromJust causes an error.
+getTxLevel :: Context -> IO CryptLevel
+getTxLevel ctx = getXLevel ctx ctxTxRecordState
+
+getRxLevel :: Context -> IO CryptLevel
+getRxLevel ctx = getXLevel ctx ctxRxRecordState
+
+getXLevel
+    :: Context
+    -> (Context -> MVar RecordState)
+    -> IO CryptLevel
+getXLevel ctx func = do
+    tx <- readMVar (func ctx)
+    return $ stCryptLevel tx
+
+class TrafficSecret ty where
+    fromTrafficSecret :: ty -> (CryptLevel, Secret)
+
+instance HasCryptLevel a => TrafficSecret (AnyTrafficSecret a) where
+    fromTrafficSecret prx@(AnyTrafficSecret s) = (getCryptLevel prx, s)
+
+instance HasCryptLevel a => TrafficSecret (ClientTrafficSecret a) where
+    fromTrafficSecret prx@(ClientTrafficSecret s) = (getCryptLevel prx, s)
+
+instance HasCryptLevel a => TrafficSecret (ServerTrafficSecret a) where
+    fromTrafficSecret prx@(ServerTrafficSecret s) = (getCryptLevel prx, s)
+
+setTxRecordState :: TrafficSecret ty => Context -> Hash -> Cipher -> ty -> IO ()
+setTxRecordState = setXState ctxTxRecordState BulkEncrypt
+
+setRxRecordState :: TrafficSecret ty => Context -> Hash -> Cipher -> ty -> IO ()
+setRxRecordState = setXState ctxRxRecordState BulkDecrypt
+
+setXState
+    :: TrafficSecret ty
+    => (Context -> MVar RecordState)
+    -> BulkDirection
+    -> Context
+    -> Hash
+    -> Cipher
+    -> ty
+    -> IO ()
+setXState func encOrDec ctx h cipher ts =
+    let (lvl, secret) = fromTrafficSecret ts
+     in setXState' func encOrDec ctx h cipher lvl secret
+
+setXState'
+    :: (Context -> MVar RecordState)
+    -> BulkDirection
+    -> Context
+    -> Hash
+    -> Cipher
+    -> CryptLevel
+    -> Secret
+    -> IO ()
+setXState' func encOrDec ctx h cipher lvl secret =
+    modifyMVar_ (func ctx) (\_ -> return rt)
+  where
+    bulk = cipherBulk cipher
+    keySize = bulkKeySize bulk
+    ivSize = max 8 (bulkIVSize bulk + bulkExplicitIV bulk)
+    key = hkdfExpandLabel h secret "key" "" keySize
+    iv = hkdfExpandLabel h secret "iv" "" ivSize
+    cst =
+        CryptState
+            { cstKey = bulkInit bulk encOrDec key
+            , cstIV = iv
+            , cstMacSecret = secret
+            }
+    rt =
+        RecordState
+            { stCryptState = cst
+            , stMacState = MacState{msSequence = 0}
+            , stCryptLevel = lvl
+            , stCipher = Just cipher
+            , stCompression = nullCompression
+            }
+
+clearTxRecordState :: Context -> IO ()
+clearTxRecordState = clearXState ctxTxRecordState
+
+clearRxRecordState :: Context -> IO ()
+clearRxRecordState = clearXState ctxRxRecordState
+
+clearXState :: (Context -> MVar RecordState) -> Context -> IO ()
+clearXState func ctx =
+    modifyMVar_ (func ctx) (\rt -> return rt{stCipher = Nothing})
+
+setPendingRecvActions :: Context -> [PendingRecvAction] -> IO ()
+setPendingRecvActions ctx = writeIORef (ctxPendingRecvActions ctx)
+
+popPendingRecvAction :: Context -> IO (Maybe PendingRecvAction)
+popPendingRecvAction ctx = do
+    let ref = ctxPendingRecvActions ctx
+    actions <- readIORef ref
+    case actions of
+        bs : bss -> writeIORef ref bss >> return (Just bs)
+        [] -> return Nothing
diff --git a/Network/TLS/Handshake/TranscriptHash.hs b/Network/TLS/Handshake/TranscriptHash.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Handshake/TranscriptHash.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.Handshake.TranscriptHash (
+    transcriptHash,
+    transcriptHashWith,
+    transitTranscriptHashI,
+    updateTranscriptHash,
+    updateTranscriptHashI,
+    transitTranscriptHash,
+    copyTranscriptHash,
+    TranscriptHash (..),
+) where
+
+import Control.Monad.State
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Crypto
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Types
+
+----------------------------------------------------------------
+
+transitTranscriptHash :: Context -> String -> Hash -> Bool -> IO ()
+transitTranscriptHash ctx label hashAlg isHRR = do
+    usingHState ctx $ modify' $ \hst ->
+        hst{hstTransHashState = transit label hashAlg isHRR $ hstTransHashState hst}
+    traceTranscriptHash ctx label hstTransHashState
+
+transitTranscriptHashI :: Context -> String -> Hash -> Bool -> IO ()
+transitTranscriptHashI ctx label hashAlg isHRR = do
+    usingHState ctx $ modify' $ \hst ->
+        hst{hstTransHashStateI = transit label hashAlg isHRR $ hstTransHashStateI hst}
+    traceTranscriptHash ctx label hstTransHashStateI
+
+transit :: String -> Hash -> Bool -> TransHashState -> TransHashState
+transit label _ _ st0@TransHashState0 = error $ "transitTranscriptHash " ++ label ++ " " ++ show st0
+transit _ _ _ st2@(TransHashState2 _) = st2
+transit _ hashAlg isHRR (TransHashState1 chs)
+    | isHRR = TransHashState2 $ hashUpdate (hashInit hashAlg) hsMsg
+    | otherwise = TransHashState2 $ hashUpdates (hashInit hashAlg) ch
+  where
+    ch = reverse chs
+    hsMsg =
+        -- Handshake message:
+        -- typ <-len-> body
+        -- 254 0 0 len hash(CH1)
+        B.concat
+            [ "\254\0\0"
+            , B.singleton len
+            , hashedCH
+            ]
+      where
+        hashedCH = hashChunks hashAlg ch
+        len = fromIntegral $ B.length hashedCH
+
+----------------------------------------------------------------
+
+updateTranscriptHash :: Context -> String -> ByteString -> IO ()
+updateTranscriptHash ctx label eh = do
+    usingHState ctx $ modify' $ \hst ->
+        hst{hstTransHashState = update eh label $ hstTransHashState hst}
+    traceTranscriptHash ctx label hstTransHashState
+
+updateTranscriptHashI :: Context -> String -> ByteString -> IO ()
+updateTranscriptHashI ctx label eh = do
+    usingHState ctx $ modify' $ \hst ->
+        hst{hstTransHashStateI = update eh label $ hstTransHashStateI hst}
+    traceTranscriptHash ctx label hstTransHashStateI
+
+update :: ByteString -> String -> TransHashState -> TransHashState
+update eh _ TransHashState0 = TransHashState1 [eh]
+update eh _ (TransHashState1 bss) = TransHashState1 (eh : bss)
+update eh _ (TransHashState2 hctx) = TransHashState2 $ hashUpdate hctx eh
+
+----------------------------------------------------------------
+
+transcriptHash :: MonadIO m => Context -> String -> m TranscriptHash
+transcriptHash ctx label = do
+    hst <- fromJust <$> getHState ctx
+    let th = calc label $ hstTransHashState hst
+    liftIO $ debugTraceKey (ctxDebug ctx) $ adjustLabel label ++ showBytesHex th
+    return $ TranscriptHash th
+
+calc :: String -> TransHashState -> ByteString
+calc _ (TransHashState2 hashCtx) = hashFinal hashCtx
+calc label st = error $ "transcriptHash " ++ label ++ " " ++ show st
+
+----------------------------------------------------------------
+
+transcriptHashWith
+    :: MonadIO m => Context -> String -> ByteString -> m TranscriptHash
+transcriptHashWith ctx label bs = do
+    role <- liftIO $ usingState_ ctx getRole
+    let isClient = role == ClientRole
+    hst <- fromJust <$> getHState ctx
+    let st
+            | isClient = hstTransHashStateI hst
+            | otherwise = hstTransHashState hst
+    let th = calcWith bs label st
+    liftIO $ debugTraceKey (ctxDebug ctx) $ adjustLabel label ++ showBytesHex th
+    return $ TranscriptHash th
+
+calcWith :: ByteString -> String -> TransHashState -> ByteString
+calcWith bs _ (TransHashState2 hashCtx) = hashFinal $ hashUpdate hashCtx bs
+calcWith _ label st = error $ "transcriptHashWith " ++ label ++ " " ++ show st
+
+----------------------------------------------------------------
+
+copyTranscriptHash :: Context -> String -> IO ()
+copyTranscriptHash ctx label = do
+    usingHState ctx $ modify' $ \hst ->
+        hst
+            { hstTransHashState = hstTransHashStateI hst
+            }
+    traceTranscriptHash ctx label hstTransHashState
+
+----------------------------------------------------------------
+
+traceTranscriptHash
+    :: Context -> String -> (HandshakeState -> TransHashState) -> IO ()
+traceTranscriptHash ctx label getField = do
+    hst <- fromJust <$> getHState ctx
+    debugTraceKey (ctxDebug ctx) $ adjustLabel label ++ show (getField hst)
+
+adjustLabel :: String -> String
+adjustLabel label = take 24 (label ++ "                      ")
diff --git a/Network/TLS/HashAndSignature.hs b/Network/TLS/HashAndSignature.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/HashAndSignature.hs
@@ -0,0 +1,181 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module Network.TLS.HashAndSignature (
+    HashAlgorithm (
+        ..,
+        HashNone,
+        HashMD5,
+        HashSHA1,
+        HashSHA224,
+        HashSHA256,
+        HashSHA384,
+        HashSHA512,
+        HashIntrinsic
+    ),
+    SignatureAlgorithm (
+        ..,
+        SignatureAnonymous,
+        SignatureRSA,
+        SignatureDSA,
+        SignatureECDSA,
+        SignatureRSApssRSAeSHA256,
+        SignatureRSApssRSAeSHA384,
+        SignatureRSApssRSAeSHA512,
+        SignatureEd25519,
+        SignatureEd448,
+        SignatureRSApsspssSHA256,
+        SignatureRSApsspssSHA384,
+        SignatureRSApsspssSHA512,
+        SignatureBrainpoolP256,
+        SignatureBrainpoolP384,
+        SignatureBrainpoolP512
+    ),
+    HashAndSignatureAlgorithm,
+    supportedSignatureSchemes,
+    signatureSchemesForTLS13,
+) where
+
+import Network.TLS.Imports
+
+------------------------------------------------------------
+
+newtype HashAlgorithm = HashAlgorithm {fromHashAlgorithm :: Word8}
+    deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern HashNone      :: HashAlgorithm
+pattern HashNone       = HashAlgorithm 0
+pattern HashMD5       :: HashAlgorithm
+pattern HashMD5        = HashAlgorithm 1
+pattern HashSHA1      :: HashAlgorithm
+pattern HashSHA1       = HashAlgorithm 2
+pattern HashSHA224    :: HashAlgorithm
+pattern HashSHA224     = HashAlgorithm 3
+pattern HashSHA256    :: HashAlgorithm
+pattern HashSHA256     = HashAlgorithm 4
+pattern HashSHA384    :: HashAlgorithm
+pattern HashSHA384     = HashAlgorithm 5
+pattern HashSHA512    :: HashAlgorithm
+pattern HashSHA512     = HashAlgorithm 6
+pattern HashIntrinsic :: HashAlgorithm
+pattern HashIntrinsic  = HashAlgorithm 8
+
+instance Show HashAlgorithm where
+    show HashNone          = "None"
+    show HashMD5           = "MD5"
+    show HashSHA1          = "SHA1"
+    show HashSHA224        = "SHA224"
+    show HashSHA256        = "SHA256"
+    show HashSHA384        = "SHA384"
+    show HashSHA512        = "SHA512"
+    show HashIntrinsic     = "TLS13"
+    show (HashAlgorithm x) = "Hash " ++ show x
+{- FOURMOLU_ENABLE -}
+
+------------------------------------------------------------
+
+newtype SignatureAlgorithm = SignatureAlgorithm {fromSignatureAlgorithm :: Word8}
+    deriving (Eq)
+
+{- FOURMOLU_DISABLE -}
+pattern SignatureAnonymous        :: SignatureAlgorithm
+pattern SignatureAnonymous         = SignatureAlgorithm 0
+pattern SignatureRSA              :: SignatureAlgorithm
+pattern SignatureRSA               = SignatureAlgorithm 1
+pattern SignatureDSA              :: SignatureAlgorithm
+pattern SignatureDSA               = SignatureAlgorithm 2
+pattern SignatureECDSA            :: SignatureAlgorithm
+pattern SignatureECDSA             = SignatureAlgorithm 3
+-- TLS 1.3 from here
+pattern SignatureRSApssRSAeSHA256 :: SignatureAlgorithm
+pattern SignatureRSApssRSAeSHA256  = SignatureAlgorithm 4
+pattern SignatureRSApssRSAeSHA384 :: SignatureAlgorithm
+pattern SignatureRSApssRSAeSHA384  = SignatureAlgorithm 5
+pattern SignatureRSApssRSAeSHA512 :: SignatureAlgorithm
+pattern SignatureRSApssRSAeSHA512  = SignatureAlgorithm 6
+pattern SignatureEd25519          :: SignatureAlgorithm
+pattern SignatureEd25519           = SignatureAlgorithm 7
+pattern SignatureEd448            :: SignatureAlgorithm
+pattern SignatureEd448             = SignatureAlgorithm 8
+pattern SignatureRSApsspssSHA256  :: SignatureAlgorithm
+pattern SignatureRSApsspssSHA256   = SignatureAlgorithm 9
+pattern SignatureRSApsspssSHA384  :: SignatureAlgorithm
+pattern SignatureRSApsspssSHA384   = SignatureAlgorithm 10
+pattern SignatureRSApsspssSHA512  :: SignatureAlgorithm
+pattern SignatureRSApsspssSHA512   = SignatureAlgorithm 11
+pattern SignatureBrainpoolP256    :: SignatureAlgorithm -- RFC8734
+pattern SignatureBrainpoolP256     = SignatureAlgorithm 26
+pattern SignatureBrainpoolP384    :: SignatureAlgorithm
+pattern SignatureBrainpoolP384     = SignatureAlgorithm 27
+pattern SignatureBrainpoolP512    :: SignatureAlgorithm
+pattern SignatureBrainpoolP512     = SignatureAlgorithm 28
+
+instance Show SignatureAlgorithm where
+    show SignatureAnonymous        = "Anonymous"
+    show SignatureRSA              = "RSA"
+    show SignatureDSA              = "DSA"
+    show SignatureECDSA            = "ECDSA"
+    show SignatureRSApssRSAeSHA256 = "RSApssRSAeSHA256"
+    show SignatureRSApssRSAeSHA384 = "RSApssRSAeSHA384"
+    show SignatureRSApssRSAeSHA512 = "RSApssRSAeSHA512"
+    show SignatureEd25519          = "Ed25519"
+    show SignatureEd448            = "Ed448"
+    show SignatureRSApsspssSHA256  = "RSApsspssSHA256"
+    show SignatureRSApsspssSHA384  = "RSApsspssSHA384"
+    show SignatureRSApsspssSHA512  = "RSApsspssSHA512"
+    show SignatureBrainpoolP256    = "BrainpoolP256"
+    show SignatureBrainpoolP384    = "BrainpoolP384"
+    show SignatureBrainpoolP512    = "BrainpoolP512"
+    show (SignatureAlgorithm x)    = "Signature " ++ show x
+{- FOURMOLU_ENABLE -}
+
+------------------------------------------------------------
+
+type HashAndSignatureAlgorithm = (HashAlgorithm, SignatureAlgorithm)
+
+{- FOURMOLU_DISABLE -}
+supportedSignatureSchemes :: [HashAndSignatureAlgorithm]
+supportedSignatureSchemes =
+    -- EdDSA algorithms
+    [ (HashIntrinsic, SignatureEd448)   -- ed448  (0x0808)
+    , (HashIntrinsic, SignatureEd25519) -- ed25519(0x0807)
+    -- ECDSA algorithms
+    , (HashSHA512,    SignatureECDSA)   -- ecdsa_secp512r1_sha512(0x0603)
+    , (HashSHA384,    SignatureECDSA)   -- ecdsa_secp384r1_sha384(0x0503)
+    , (HashSHA256,    SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)
+    -- RSASSA-PSS RSAE algorithms
+    , (HashIntrinsic, SignatureRSApssRSAeSHA512) -- rsa_pss_rsae_sha512(0x0806)
+    , (HashIntrinsic, SignatureRSApssRSAeSHA384) -- rsa_pss_rsae_sha384(0x0805)
+    , (HashIntrinsic, SignatureRSApssRSAeSHA256) -- rsa_pss_rsae_sha256(0x0804)
+    -- RSASSA-PSS PSS algorithms with
+    , (HashIntrinsic, SignatureRSApsspssSHA512)  -- rsa_pss_pss_sha512(0x080b)
+    , (HashIntrinsic, SignatureRSApsspssSHA384)  -- rsa_pss_pss_sha384(0x080a)
+    , (HashIntrinsic, SignatureRSApsspssSHA256)  -- rsa_pss_pss_sha256(0x0809)
+    -- RSASSA-PKCS1-v1_5 algorithms
+    , (HashSHA512,    SignatureRSA)    -- rsa_pkcs1_sha512(0x0601)
+    , (HashSHA384,    SignatureRSA)    -- rsa_pkcs1_sha384(0x0501)
+    , (HashSHA256,    SignatureRSA)    -- rsa_pkcs1_sha256(0x0401)
+    -- Legacy algorithms
+    , (HashSHA1,      SignatureRSA)    -- rsa_pkcs1_sha1  (0x0201)
+    , (HashSHA1,      SignatureECDSA)  -- ecdsa_sha1      (0x0203)
+    ]
+
+signatureSchemesForTLS13 :: [(HashAlgorithm, SignatureAlgorithm)]
+signatureSchemesForTLS13 =
+    -- EdDSA algorithms
+    [ (HashIntrinsic, SignatureEd448)   -- ed448  (0x0808)
+    , (HashIntrinsic, SignatureEd25519) -- ed25519(0x0807)
+    -- ECDSA algorithms
+    , (HashSHA512,    SignatureECDSA)   -- ecdsa_secp512r1_sha512(0x0603)
+    , (HashSHA384,    SignatureECDSA)   -- ecdsa_secp384r1_sha384(0x0503)
+    , (HashSHA256,    SignatureECDSA)   -- ecdsa_secp256r1_sha256(0x0403)
+    -- RSASSA-PSS RSAE algorithms
+    , (HashIntrinsic, SignatureRSApssRSAeSHA512) -- rsa_pss_rsae_sha512(0x0806)
+    , (HashIntrinsic, SignatureRSApssRSAeSHA384) -- rsa_pss_rsae_sha384(0x0805)
+    , (HashIntrinsic, SignatureRSApssRSAeSHA256) -- rsa_pss_rsae_sha256(0x0804)
+    -- RSASSA-PSS PSS algorithms with
+    , (HashIntrinsic, SignatureRSApsspssSHA512)  -- rsa_pss_pss_sha512(0x080b)
+    , (HashIntrinsic, SignatureRSApsspssSHA384)  -- rsa_pss_pss_sha384(0x080a)
+    , (HashIntrinsic, SignatureRSApsspssSHA256)  -- rsa_pss_pss_sha256(0x0809)
+    ]
+{- FOURMOLU_ENABLE -}
diff --git a/Network/TLS/Hooks.hs b/Network/TLS/Hooks.hs
--- a/Network/TLS/Hooks.hs
+++ b/Network/TLS/Hooks.hs
@@ -1,20 +1,16 @@
--- |
--- Module      : Network.TLS.Context
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Hooks
-    ( Logging(..)
-    , Hooks(..)
-    , defaultHooks
-    ) where
+module Network.TLS.Hooks (
+    Logging (..),
+    defaultLogging,
+    Hooks (..),
+    defaultHooks,
+) where
 
-import qualified Data.ByteString as B
-import Network.TLS.Struct (Header, Handshake(..))
+import Data.Default (Default (def))
+
+import Network.TLS.Imports
+import Network.TLS.Struct (Handshake, Header)
+import Network.TLS.Struct13 (Handshake13)
 import Network.TLS.X509 (CertificateChain)
-import Data.Default.Class
 
 -- | Hooks for logging
 --
@@ -22,37 +18,42 @@
 data Logging = Logging
     { loggingPacketSent :: String -> IO ()
     , loggingPacketRecv :: String -> IO ()
-    , loggingIOSent     :: B.ByteString -> IO ()
-    , loggingIORecv     :: Header -> B.ByteString -> IO ()
+    , loggingIOSent :: ByteString -> IO ()
+    , loggingIORecv :: Header -> ByteString -> IO ()
     }
 
 defaultLogging :: Logging
-defaultLogging = Logging
-    { loggingPacketSent = (\_ -> return ())
-    , loggingPacketRecv = (\_ -> return ())
-    , loggingIOSent     = (\_ -> return ())
-    , loggingIORecv     = (\_ _ -> return ())
-    }
+defaultLogging =
+    Logging
+        { loggingPacketSent = \_ -> return ()
+        , loggingPacketRecv = \_ -> return ()
+        , loggingIOSent = \_ -> return ()
+        , loggingIORecv = \_ _ -> return ()
+        }
 
 instance Default Logging where
     def = defaultLogging
 
 -- | A collection of hooks actions.
 data Hooks = Hooks
-    { -- | called at each handshake message received
-      hookRecvHandshake    :: Handshake -> IO Handshake
-      -- | called at each certificate chain message received
+    { hookRecvHandshake :: Handshake -> IO Handshake
+    -- ^ called at each handshake message received
+    , hookRecvHandshake13 :: Handshake13 -> IO Handshake13
+    -- ^ called at each handshake message received for TLS 1.3
     , hookRecvCertificates :: CertificateChain -> IO ()
-      -- | hooks on IO and packets, receiving and sending.
-    , hookLogging          :: Logging
+    -- ^ called at each certificate chain message received
+    , hookLogging :: Logging
+    -- ^ hooks on IO and packets, receiving and sending.
     }
 
 defaultHooks :: Hooks
-defaultHooks = Hooks
-    { hookRecvHandshake    = \hs -> return hs
-    , hookRecvCertificates = return . const ()
-    , hookLogging          = def
-    }
+defaultHooks =
+    Hooks
+        { hookRecvHandshake = return
+        , hookRecvHandshake13 = return
+        , hookRecvCertificates = return . const ()
+        , hookLogging = def
+        }
 
 instance Default Hooks where
     def = defaultHooks
diff --git a/Network/TLS/IO.hs b/Network/TLS/IO.hs
--- a/Network/TLS/IO.hs
+++ b/Network/TLS/IO.hs
@@ -1,122 +1,240 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE CPP #-}
--- |
--- Module      : Network.TLS.IO
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.IO
-    ( checkValid
-    , sendPacket
-    , recvPacket
-    ) where
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
 
+module Network.TLS.IO (
+    sendPacket12,
+    sendPacket13,
+    recvPacket12,
+    recvPacket13,
+    --
+    isRecvComplete,
+    checkValid,
+
+    -- * Grouping multiple packets in the same flight
+    PacketFlightM,
+    runPacketFlight,
+    loadPacket13,
+) where
+
+import Control.Exception (finally, throwIO)
+import Control.Monad.Reader
+import Control.Monad.State.Strict
+import qualified Data.ByteString as B
+import Data.IORef
+
 import Network.TLS.Context.Internal
-import Network.TLS.Struct
-import Network.TLS.Record
-import Network.TLS.Packet
 import Network.TLS.Hooks
-import Network.TLS.Sending
-import Network.TLS.Receiving
-import qualified Data.ByteString as B
-import Data.ByteString.Char8 ()
+import Network.TLS.IO.Decode
+import Network.TLS.IO.Encode
+import Network.TLS.Imports
+import Network.TLS.Parameters
+import Network.TLS.Record
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
 
-import Data.IORef
-import Control.Monad.State
-import Control.Exception (throwIO)
-import System.IO.Error (mkIOError, eofErrorType)
+----------------------------------------------------------------
 
+-- | Send one packet to the context
+sendPacket12 :: Context -> Packet -> IO ()
+sendPacket12 ctx@Context{ctxRecordLayer = recordLayer} pkt = do
+    -- in ver <= TLS1.0, block ciphers using CBC are using CBC residue
+    -- as IV, which can be guessed by an attacker. Hence, an empty
+    -- packet is sent before a normal data packet, to prevent
+    -- guessability.
+    when (isNonNullAppData pkt) $ do
+        withEmptyPacket <- readIORef $ ctxNeedEmptyPacket ctx
+        when withEmptyPacket $
+            writePacketBytes12 ctx recordLayer (AppData B.empty)
+                >>= recordSendBytes recordLayer ctx
+
+    writePacketBytes12 ctx recordLayer pkt >>= recordSendBytes recordLayer ctx
+  where
+    isNonNullAppData (AppData b) = not $ B.null b
+    isNonNullAppData _ = False
+
+writePacketBytes12
+    :: Monoid bytes
+    => Context
+    -> RecordLayer bytes
+    -> Packet
+    -> IO bytes
+writePacketBytes12 ctx recordLayer pkt = do
+    withLog ctx $ \logging -> loggingPacketSent logging (show pkt)
+    edataToSend <- encodePacket12 ctx recordLayer pkt
+    either throwCore return edataToSend
+
+----------------------------------------------------------------
+
+sendPacket13 :: Context -> Packet13 -> IO ()
+sendPacket13 ctx@Context{ctxRecordLayer = recordLayer} pkt =
+    writePacketBytes13 ctx recordLayer pkt >>= recordSendBytes recordLayer ctx
+
+writePacketBytes13
+    :: Monoid bytes
+    => Context
+    -> RecordLayer bytes
+    -> Packet13
+    -> IO bytes
+writePacketBytes13 ctx recordLayer pkt = do
+    withLog ctx $ \logging -> loggingPacketSent logging (show pkt)
+    edataToSend <- encodePacket13 ctx recordLayer pkt
+    either throwCore return edataToSend
+
+----------------------------------------------------------------
+
+-- | receive one packet from the context that contains 1 or
+-- many messages (many only in case of handshake). if will returns a
+-- TLSError if the packet is unexpected or malformed
+recvPacket12 :: Context -> IO (Either TLSError Packet)
+recvPacket12 ctx@Context{ctxRecordLayer = recordLayer} = loop 0
+  where
+    lim = limitHandshakeFragment $ sharedLimit $ ctxShared ctx
+    loop count
+        | count > lim = do
+            let err = Error_Packet "too many handshake fragment"
+            logPacket ctx $ show err
+            return $ Left err
+    loop count = do
+        hrr <- usingState_ ctx getTLS13HRR
+        erecord <- recordRecv12 recordLayer ctx
+        case erecord of
+            Left err -> do
+                logPacket ctx $ show err
+                return $ Left err
+            Right record
+                | hrr && isCCS record -> loop (count + 1)
+                | otherwise -> do
+                    pktRecv <- decodePacket12 ctx record
+                    if isEmptyHandshake pktRecv
+                        then do
+                            logPacket ctx "Handshake fragment"
+                            -- When a handshake record is fragmented
+                            -- we continue receiving in order to feed
+                            -- stHandshakeRecordCont
+                            loop (count + 1)
+                        else case pktRecv of
+                            Right (Handshake hss bss) -> do
+                                pktRecv'@(Right pkt) <- ctxWithHooks ctx $ \hooks -> do
+                                    hss' <- mapM (hookRecvHandshake hooks) hss
+                                    return $ Right $ Handshake hss' bss
+                                logPacket ctx $ show pkt
+                                return pktRecv'
+                            Right pkt -> do
+                                logPacket ctx $ show pkt
+                                return pktRecv
+                            Left err -> do
+                                logPacket ctx $ show err
+                                return pktRecv
+
+isCCS :: Record a -> Bool
+isCCS (Record ProtocolType_ChangeCipherSpec _ _) = True
+isCCS _ = False
+
+isEmptyHandshake :: Either TLSError Packet -> Bool
+isEmptyHandshake (Right (Handshake [] _)) = True
+isEmptyHandshake _ = False
+
+logPacket :: Context -> String -> IO ()
+logPacket ctx msg = withLog ctx $ \logging -> loggingPacketRecv logging msg
+
+----------------------------------------------------------------
+
+recvPacket13 :: Context -> IO (Either TLSError Packet13)
+recvPacket13 ctx@Context{ctxRecordLayer = recordLayer} = loop 0
+  where
+    lim = limitHandshakeFragment $ sharedLimit $ ctxShared ctx
+    loop count
+        | count > lim =
+            return $ Left $ Error_Packet "too many handshake fragment"
+    loop count = do
+        erecord <- recordRecv13 recordLayer ctx
+        case erecord of
+            Left err@(Error_Protocol _ BadRecordMac) -> do
+                -- If the server decides to reject RTT0 data but accepts RTT1
+                -- data, the server should skip all records for RTT0 data.
+                logPacket ctx $ show err
+                established <- ctxEstablished ctx
+                case established of
+                    EarlyDataNotAllowed n
+                        | n > 0 -> do
+                            setEstablished ctx $ EarlyDataNotAllowed (n - 1)
+                            loop (count + 1)
+                    _ -> return $ Left err
+            Left err -> do
+                logPacket ctx $ show err
+                return $ Left err
+            Right record -> do
+                pktRecv <- decodePacket13 ctx record
+                if isEmptyHandshake13 pktRecv
+                    then do
+                        logPacket ctx "Handshake fragment"
+                        -- When a handshake record is fragmented we
+                        -- continue receiving in order to feed
+                        -- stHandshakeRecordCont13
+                        loop (count + 1)
+                    else do
+                        case pktRecv of
+                            Right (Handshake13 hss bss) -> do
+                                pktRecv'@(Right pkt) <- ctxWithHooks ctx $ \hooks -> do
+                                    hss' <- mapM (hookRecvHandshake13 hooks) hss
+                                    return $ Right $ Handshake13 hss' bss
+                                logPacket ctx $ show pkt
+                                return pktRecv'
+                            Right pkt -> do
+                                logPacket ctx $ show pkt
+                                return pktRecv
+                            Left err -> do
+                                logPacket ctx $ show err
+                                return pktRecv
+
+isEmptyHandshake13 :: Either TLSError Packet13 -> Bool
+isEmptyHandshake13 (Right (Handshake13 [] _)) = True
+isEmptyHandshake13 _ = False
+
+----------------------------------------------------------------
+
+isRecvComplete :: Context -> IO Bool
+isRecvComplete ctx = usingState_ ctx $ do
+    cont12 <- gets stHandshakeRecordCont12
+    cont13 <- gets stHandshakeRecordCont13
+    return $ isNothing (fst cont12) && isNothing (fst cont13)
+
 checkValid :: Context -> IO ()
 checkValid ctx = do
     established <- ctxEstablished ctx
-    unless established $ liftIO $ throwIO ConnectionNotEstablished
+    when (established == NotEstablished) $ throwIO ConnectionNotEstablished
     eofed <- ctxEOF ctx
-    when eofed $ liftIO $ throwIO $ mkIOError eofErrorType "data" Nothing Nothing
+    when eofed $ throwIO $ PostHandshake Error_EOF
 
-readExact :: Context -> Int -> IO Bytes
-readExact ctx sz = do
-    hdrbs <- liftIO $ contextRecv ctx sz
-    when (B.length hdrbs < sz) $ do
-        setEOF ctx
-        if B.null hdrbs
-            then throwCore Error_EOF
-            else throwCore (Error_Packet ("partial packet: expecting " ++ show sz ++ " bytes, got: " ++ (show $B.length hdrbs)))
-    return hdrbs
+----------------------------------------------------------------
 
--- | recvRecord receive a full TLS record (header + data), from the other side.
---
--- The record is disengaged from the record layer
-recvRecord :: Bool    -- ^ flag to enable SSLv2 compat ClientHello reception
-           -> Context -- ^ TLS context
-           -> IO (Either TLSError (Record Plaintext))
-recvRecord compatSSLv2 ctx
-#ifdef SSLV2_COMPATIBLE
-    | compatSSLv2 = do
-        header <- readExact ctx 2
-        if B.head header < 0x80
-            then readExact ctx 3 >>= either (return . Left) recvLength . decodeHeader . B.append header
-            else either (return . Left) recvDeprecatedLength $ decodeDeprecatedHeaderLength header
-#endif
-    | otherwise = readExact ctx 5 >>= either (return . Left) recvLength . decodeHeader
-        where recvLength header@(Header _ _ readlen)
-                | readlen > 16384 + 2048 = return $ Left maximumSizeExceeded
-                | otherwise              = readExact ctx (fromIntegral readlen) >>= getRecord header
-#ifdef SSLV2_COMPATIBLE
-              recvDeprecatedLength readlen
-                | readlen > 1024 * 4     = return $ Left maximumSizeExceeded
-                | otherwise              = do
-                    content <- readExact ctx (fromIntegral readlen)
-                    case decodeDeprecatedHeader readlen content of
-                        Left err     -> return $ Left err
-                        Right header -> getRecord header content
-#endif
-              maximumSizeExceeded = Error_Protocol ("record exceeding maximum size", True, RecordOverflow)
-              getRecord :: Header -> Bytes -> IO (Either TLSError (Record Plaintext))
-              getRecord header content = do
-                    liftIO $ withLog ctx $ \logging -> loggingIORecv logging header content
-                    runRxState ctx $ disengageRecord $ rawToRecord header (fragmentCiphertext content)
+type Builder b = [b] -> [b]
 
+-- | State monad used to group several packets together and send them on wire as
+-- single flight.  When packets are loaded in the monad, they are logged
+-- immediately, update the context digest and transcript, but actual sending is
+-- deferred.  Packets are sent all at once when the monadic computation ends
+-- (normal termination but also if interrupted by an exception).
+newtype PacketFlightM b a
+    = PacketFlightM (ReaderT (RecordLayer b, IORef (Builder b)) IO a)
+    deriving (Functor, Applicative, Monad, MonadFail, MonadIO)
 
--- | receive one packet from the context that contains 1 or
--- many messages (many only in case of handshake). if will returns a
--- TLSError if the packet is unexpected or malformed
-recvPacket :: MonadIO m => Context -> m (Either TLSError Packet)
-recvPacket ctx = liftIO $ do
-    compatSSLv2 <- ctxHasSSLv2ClientHello ctx
-    erecord     <- recvRecord compatSSLv2 ctx
-    case erecord of
-        Left err     -> return $ Left err
-        Right record -> do
-            pktRecv <- processPacket ctx record
-            pkt <- case pktRecv of
-                    Right (Handshake hss) ->
-                        ctxWithHooks ctx $ \hooks ->
-                            (mapM (hookRecvHandshake hooks) hss) >>= return . Right . Handshake
-                    _                     -> return pktRecv
-            case pkt of
-                Right p -> withLog ctx $ \logging -> loggingPacketRecv logging $ show p
-                _       -> return ()
-            when compatSSLv2 $ ctxDisableSSLv2ClientHello ctx
-            return pkt
+runPacketFlight :: Context -> (forall b. Monoid b => PacketFlightM b a) -> IO a
+runPacketFlight ctx@Context{ctxRecordLayer = recordLayer} (PacketFlightM f) = do
+    ref <- newIORef id
+    runReaderT f (recordLayer, ref) `finally` sendPendingFlight ctx recordLayer ref
 
--- | Send one packet to the context
-sendPacket :: MonadIO m => Context -> Packet -> m ()
-sendPacket ctx pkt = do
-    -- in ver <= TLS1.0, block ciphers using CBC are using CBC residue as IV, which can be guessed
-    -- by an attacker. Hence, an empty packet is sent before a normal data packet, to
-    -- prevent guessability.
-    withEmptyPacket <- liftIO $ readIORef $ ctxNeedEmptyPacket ctx
-    when (isNonNullAppData pkt && withEmptyPacket) $ sendPacket ctx $ AppData B.empty
+sendPendingFlight
+    :: Monoid b => Context -> RecordLayer b -> IORef (Builder b) -> IO ()
+sendPendingFlight ctx recordLayer ref = do
+    build <- readIORef ref
+    let bss = build []
+    unless (null bss) $ recordSendBytes recordLayer ctx $ mconcat bss
 
-    edataToSend <- liftIO $ do
-                        withLog ctx $ \logging -> loggingPacketSent logging (show pkt)
-                        writePacket ctx pkt
-    case edataToSend of
-        Left err         -> throwCore err
-        Right dataToSend -> liftIO $ do
-            withLog ctx $ \logging -> loggingIOSent logging dataToSend
-            contextSend ctx dataToSend
-  where isNonNullAppData (AppData b) = not $ B.null b
-        isNonNullAppData _           = False
+loadPacket13 :: Monoid b => Context -> Packet13 -> PacketFlightM b ()
+loadPacket13 ctx pkt = PacketFlightM $ do
+    (recordLayer, ref) <- ask
+    liftIO $ do
+        bs <- writePacketBytes13 ctx recordLayer pkt
+        modifyIORef' ref (. (bs :))
diff --git a/Network/TLS/IO/Decode.hs b/Network/TLS/IO/Decode.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/IO/Decode.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Network.TLS.IO.Decode (
+    decodePacket12,
+    decodePacket13,
+) where
+
+import Control.Concurrent.MVar
+import Control.Monad.State.Strict
+import qualified Data.ByteString as BS
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.ErrT
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Packet13
+import Network.TLS.Record
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Util
+import Network.TLS.Wire
+
+decodePacket12 :: Context -> Record Plaintext -> IO (Either TLSError Packet)
+decodePacket12 _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData $ fragmentGetBytes fragment
+decodePacket12 _ (Record ProtocolType_Alert _ fragment) = return (Alert `fmapEither` decodeAlerts (fragmentGetBytes fragment))
+decodePacket12 ctx (Record ProtocolType_ChangeCipherSpec _ fragment) =
+    case decodeChangeCipherSpec $ fragmentGetBytes fragment of
+        Left err -> return $ Left err
+        Right _ -> do
+            switchRxEncryption ctx
+            return $ Right ChangeCipherSpec
+decodePacket12 ctx (Record ProtocolType_Handshake ver fragment) = do
+    keyxchg <-
+        getHState ctx >>= \hs -> return (hs >>= hstPendingCipher >>= Just . cipherKeyExchange)
+    usingState ctx $ do
+        let currentParams =
+                CurrentParams
+                    { cParamsVersion = ver
+                    , cParamsKeyXchgType = keyxchg
+                    }
+        -- get back the optional continuation, and parse as many handshake record as possible.
+        (mCont, wirebytes) <- gets stHandshakeRecordCont12
+        modify' (\st -> st{stHandshakeRecordCont12 = (Nothing, [])})
+        (hss, bss) <-
+            unzip <$> parseMany currentParams mCont wirebytes (fragmentGetBytes fragment)
+        return $ Handshake hss bss
+  where
+    parseMany currentParams mCont wirebytes bs =
+        case fromMaybe decodeHandshakeRecord mCont bs of
+            GotError err -> throwError err
+            GotPartial cont -> do
+                modify' (\st -> st{stHandshakeRecordCont12 = (Just cont, bs : wirebytes)})
+                return []
+            GotSuccess (ty, content) ->
+                case decodeHandshake currentParams ty content of
+                    Left err -> throwError err
+                    Right h -> return [(h, reverse (bs : wirebytes))]
+            GotSuccessRemaining (ty, content) left ->
+                case decodeHandshake currentParams ty content of
+                    Left err -> throwError err
+                    Right h -> do
+                        hbs <- parseMany currentParams Nothing [] left
+                        let len = BS.length bs - BS.length left
+                            bs' = BS.take len bs
+                        return ((h, reverse (bs' : wirebytes)) : hbs)
+decodePacket12 _ _ = return $ Left (Error_Packet_Parsing "unknown protocol type")
+
+switchRxEncryption :: Context -> IO ()
+switchRxEncryption ctx =
+    usingHState ctx (gets hstPendingRxState) >>= \rx ->
+        modifyMVar_ (ctxRxRecordState ctx) (\_ -> return $ fromJust rx)
+
+----------------------------------------------------------------
+
+decodePacket13 :: Context -> Record Plaintext -> IO (Either TLSError Packet13)
+decodePacket13 _ (Record ProtocolType_ChangeCipherSpec _ fragment) =
+    case decodeChangeCipherSpec $ fragmentGetBytes fragment of
+        Left err -> return $ Left err
+        Right _ -> return $ Right ChangeCipherSpec13
+decodePacket13 _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData13 $ fragmentGetBytes fragment
+decodePacket13 _ (Record ProtocolType_Alert _ fragment) = return (Alert13 `fmapEither` decodeAlerts (fragmentGetBytes fragment))
+decodePacket13 ctx (Record ProtocolType_Handshake _ fragment) = usingState ctx $ do
+    (mCont, wirebytes) <- gets stHandshakeRecordCont13
+    modify' (\st -> st{stHandshakeRecordCont13 = (Nothing, [])})
+    (hss, bss) <- unzip <$> parseMany mCont wirebytes (fragmentGetBytes fragment)
+    return $ Handshake13 hss bss
+  where
+    parseMany mCont wirebytes bs =
+        case fromMaybe decodeHandshakeRecord13 mCont bs of
+            GotError err -> throwError err
+            GotPartial cont -> do
+                modify' (\st -> st{stHandshakeRecordCont13 = (Just cont, bs : wirebytes)})
+                return []
+            GotSuccess (ty, content) ->
+                case decodeHandshake13 ty content of
+                    Left err -> throwError err
+                    Right h -> return [(h, reverse (bs : wirebytes))]
+            GotSuccessRemaining (ty, content) left ->
+                case decodeHandshake13 ty content of
+                    Left err -> throwError err
+                    Right h -> do
+                        hbs <- parseMany Nothing [] left
+                        let len = BS.length bs - BS.length left
+                            bs' = BS.take len bs
+                        return ((h, reverse (bs' : wirebytes)) : hbs)
+decodePacket13 _ _ = return $ Left (Error_Packet_Parsing "unknown protocol type")
diff --git a/Network/TLS/IO/Encode.hs b/Network/TLS/IO/Encode.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/IO/Encode.hs
@@ -0,0 +1,148 @@
+module Network.TLS.IO.Encode (
+    encodePacket12,
+    encodePacket13,
+    updateTranscriptHash12,
+    encodeUpdateTranscriptHash12,
+    updateTranscriptHash13,
+    encodeUpdateTranscriptHash13,
+) where
+
+import Control.Concurrent.MVar
+import Control.Monad.State.Strict
+import qualified Data.ByteString as B
+import Data.IORef
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.TranscriptHash
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Packet13
+import Network.TLS.Parameters
+import Network.TLS.Record
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types (Role (..))
+import Network.TLS.Util
+
+-- | encodePacket transform a packet into marshalled data related to current state
+-- and updating state on the go
+encodePacket12
+    :: Monoid bytes
+    => Context
+    -> RecordLayer bytes
+    -> Packet
+    -> IO (Either TLSError bytes)
+encodePacket12 ctx recordLayer pkt = do
+    (ver, _) <- decideRecordVersion ctx
+    let pt = packetType pkt
+        mkRecord bs = Record pt ver (fragmentPlaintext bs)
+    mlen <- getPeerRecordLimit ctx
+    records <- map mkRecord <$> packetToFragments12 ctx mlen pkt
+    bs <- fmap mconcat <$> forEitherM records (recordEncode12 recordLayer ctx)
+    when (pkt == ChangeCipherSpec) $ switchTxEncryption ctx
+    return bs
+
+-- Decompose handshake packets into fragments of the specified length.  AppData
+-- packets are not fragmented here but by callers of sendPacket, so that the
+-- empty-packet countermeasure may be applied to each fragment independently.
+packetToFragments12 :: Context -> Maybe Int -> Packet -> IO [ByteString]
+packetToFragments12 ctx mlen (Handshake hss _) =
+    getChunks mlen . B.concat <$> mapM (encodeUpdateTranscriptHash12 ctx) hss
+packetToFragments12 _ _ (Alert a) = return [encodeAlerts a]
+packetToFragments12 _ _ ChangeCipherSpec = return [encodeChangeCipherSpec]
+packetToFragments12 _ _ (AppData x) = return [x]
+
+switchTxEncryption :: Context -> IO ()
+switchTxEncryption ctx = do
+    tx <- usingHState ctx (fromJust <$> gets hstPendingTxState)
+    (ver, role) <- usingState_ ctx $ do
+        v <- getVersion
+        r <- getRole
+        return (v, r)
+    liftIO $ modifyMVar_ (ctxTxRecordState ctx) (\_ -> return tx)
+    -- set empty packet counter measure if condition are met
+    when
+        ( ver <= TLS10
+            && role == ClientRole
+            && isCBC tx
+            && supportedEmptyPacket (ctxSupported ctx)
+        )
+        $ liftIO
+        $ writeIORef (ctxNeedEmptyPacket ctx) True
+  where
+    isCBC tx = maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stCipher tx)
+
+encodeUpdateTranscriptHash12 :: Context -> Handshake -> IO ByteString
+encodeUpdateTranscriptHash12 ctx hs = do
+    when (certVerifyHandshakeMaterial hs) $
+        usingHState ctx $
+            addHandshakeMessage encoded
+    let label = show $ typeOfHandshake hs
+    when (finishedHandshakeMaterial hs) $ updateTranscriptHash ctx label encoded
+    when (isClientHello hs) $ do
+        usingHState ctx $ do
+            (ch, b) <- fromJust <$> getClientHello
+            when (null b) $ setClientHello ch [encoded]
+    return encoded
+  where
+    encoded = encodeHandshake hs
+    isClientHello (ClientHello _) = True
+    isClientHello _ = False
+
+updateTranscriptHash12 :: Context -> HandshakeR -> IO ()
+updateTranscriptHash12 ctx (hs, bss) = do
+    when (certVerifyHandshakeMaterial hs) $
+        usingHState ctx $
+            mapM_ addHandshakeMessage bss
+    let label = show $ typeOfHandshake hs
+    when (finishedHandshakeMaterial hs) $ do
+        mapM_ (updateTranscriptHash ctx label) bss
+
+----------------------------------------------------------------
+
+encodePacket13
+    :: Monoid bytes
+    => Context
+    -> RecordLayer bytes
+    -> Packet13
+    -> IO (Either TLSError bytes)
+encodePacket13 ctx recordLayer pkt = do
+    let pt = contentType pkt
+        mkRecord bs = Record pt TLS12 (fragmentPlaintext bs)
+    mlen <- getPeerRecordLimit ctx
+    records <- map mkRecord <$> packetToFragments13 ctx mlen pkt
+    fmap mconcat <$> forEitherM records (recordEncode13 recordLayer ctx)
+
+packetToFragments13 :: Context -> Maybe Int -> Packet13 -> IO [ByteString]
+packetToFragments13 ctx mlen (Handshake13 hss _) =
+    getChunks mlen . B.concat <$> mapM (encodeUpdateTranscriptHash13 ctx) hss
+packetToFragments13 _ _ (Alert13 a) = return [encodeAlerts a]
+packetToFragments13 _ _ (AppData13 x) = return [x]
+packetToFragments13 _ _ ChangeCipherSpec13 = return [encodeChangeCipherSpec]
+
+encodeUpdateTranscriptHash13 :: Context -> Handshake13 -> IO ByteString
+encodeUpdateTranscriptHash13 ctx hs
+    | isIgnored hs = return encoded
+    | otherwise = do
+        let label = show $ typeOfHandshake13 hs
+        updateTranscriptHash ctx label encoded
+        usingHState ctx $ addHandshakeMessage encoded
+        return encoded
+  where
+    encoded = encodeHandshake13 hs
+
+updateTranscriptHash13 :: Context -> Handshake13R -> IO ()
+updateTranscriptHash13 ctx (hs, bss)
+    | isIgnored hs = return ()
+    | otherwise = do
+        let label = show $ typeOfHandshake13 hs
+        mapM_ (updateTranscriptHash ctx label) bss
+        usingHState ctx $ mapM_ addHandshakeMessage bss
+
+isIgnored :: Handshake13 -> Bool
+isIgnored NewSessionTicket13{} = True
+isIgnored KeyUpdate13{} = True
+isIgnored _ = False
diff --git a/Network/TLS/Imports.hs b/Network/TLS/Imports.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Imports.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Network.TLS.Imports (
+    -- generic exports
+    ByteString,
+    (<&>),
+    module Control.Applicative,
+    module Control.Monad,
+    module Data.Bits,
+    module Data.List,
+    module Data.Maybe,
+    module Data.Semigroup,
+    module Data.Ord,
+    module Data.Word,
+    -- project definition
+    showBytesHex,
+) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Bits
+import Data.ByteArray.Encoding as B
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 ()
+import Data.Functor
+import Data.List
+import Data.Maybe
+import Data.Ord
+import Data.Semigroup
+import Data.Word
+import qualified Prelude as P
+
+showBytesHex :: ByteString -> P.String
+showBytesHex bs = P.show (B.convertToBase B.Base16 bs :: ByteString)
diff --git a/Network/TLS/Internal.hs b/Network/TLS/Internal.hs
--- a/Network/TLS/Internal.hs
+++ b/Network/TLS/Internal.hs
@@ -1,24 +1,37 @@
 {-# OPTIONS_HADDOCK hide #-}
--- |
--- Module      : Network.TLS.Internal
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Internal
-    ( module Network.TLS.Struct
-    , module Network.TLS.Packet
-    , module Network.TLS.Receiving
-    , module Network.TLS.Sending
-    , module Network.TLS.Wire
-    , sendPacket
-    , recvPacket
-    ) where
 
-import Network.TLS.Struct
+module Network.TLS.Internal (
+    module Network.TLS.Extension,
+    module Network.TLS.IO.Decode,
+    module Network.TLS.IO.Encode,
+    module Network.TLS.Packet,
+    module Network.TLS.Packet13,
+    module Network.TLS.Struct,
+    module Network.TLS.Struct13,
+    module Network.TLS.Types,
+    module Network.TLS.Wire,
+    module Network.TLS.X509,
+    sendPacket12,
+    recvPacket12,
+    makeCipherShowPretty,
+) where
+
+import Data.IORef
+
+import Network.TLS.Core (recvPacket12, sendPacket12)
+import Network.TLS.Extension
+import Network.TLS.Extra.Cipher
+import Network.TLS.IO.Decode
+import Network.TLS.IO.Encode
 import Network.TLS.Packet
-import Network.TLS.Receiving
-import Network.TLS.Sending
+import Network.TLS.Packet13
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
 import Network.TLS.Wire
-import Network.TLS.Core (sendPacket, recvPacket)
+import Network.TLS.X509 hiding (Certificate)
+
+----------------------------------------------------------------
+
+makeCipherShowPretty :: IO ()
+makeCipherShowPretty = writeIORef globalCipherDict ciphersuite_all
diff --git a/Network/TLS/KeySchedule.hs b/Network/TLS/KeySchedule.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/KeySchedule.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.TLS.KeySchedule (
+    hkdfExtract,
+    hkdfExpandLabel,
+    deriveSecret,
+) where
+
+import qualified Crypto.Hash as H
+import Crypto.KDF.HKDF
+import Data.ByteArray (ByteArray, ByteArrayAccess, convert)
+import qualified Data.ByteString as BS
+
+import Network.TLS.Crypto
+import Network.TLS.Imports
+import Network.TLS.Types
+import Network.TLS.Wire
+
+----------------------------------------------------------------
+
+-- | @HKDF-Extract@ function.  Returns the pseudorandom key (PRK) from salt and
+-- input keying material (IKM).
+hkdfExtract
+    :: (ByteArray ba, ByteArrayAccess ba) => Hash -> ba -> ba -> ba
+hkdfExtract SHA1 salt ikm = convert (extract salt ikm :: PRK H.SHA1)
+hkdfExtract SHA256 salt ikm = convert (extract salt ikm :: PRK H.SHA256)
+hkdfExtract SHA384 salt ikm = convert (extract salt ikm :: PRK H.SHA384)
+hkdfExtract SHA512 salt ikm = convert (extract salt ikm :: PRK H.SHA512)
+hkdfExtract _ _ _ = error "hkdfExtract: unsupported hash"
+
+----------------------------------------------------------------
+
+deriveSecret :: Hash -> Secret -> ByteString -> TranscriptHash -> Secret
+deriveSecret h secret label (TranscriptHash hashedMsgs) =
+    hkdfExpandLabel h secret label hashedMsgs outlen
+  where
+    outlen = hashDigestSize h
+
+----------------------------------------------------------------
+
+-- | @HKDF-Expand-Label@ function.  Returns output keying material of the
+-- specified length from the PRK, customized for a TLS label and context.
+hkdfExpandLabel
+    :: (ByteArray ba, ByteArrayAccess ba)
+    => Hash
+    -> Secret
+    -> ByteString
+    -> ByteString
+    -> Int
+    -> ba
+hkdfExpandLabel h secret label ctx outlen = expand' h secret hkdfLabel outlen
+  where
+    hkdfLabel = runPut $ do
+        putWord16 $ fromIntegral outlen
+        putOpaque8 ("tls13 " `BS.append` label)
+        putOpaque8 ctx
+
+expand'
+    :: (ByteArray ba, ByteArrayAccess ba) => Hash -> Secret -> ByteString -> Int -> ba
+expand' SHA1 secret label len = expand (extractSkip secret :: PRK H.SHA1) label len
+expand' SHA256 secret label len = expand (extractSkip secret :: PRK H.SHA256) label len
+expand' SHA384 secret label len = expand (extractSkip secret :: PRK H.SHA384) label len
+expand' SHA512 secret label len = expand (extractSkip secret :: PRK H.SHA512) label len
+expand' _ _ _ _ = error "expand'"
+
+----------------------------------------------------------------
diff --git a/Network/TLS/MAC.hs b/Network/TLS/MAC.hs
--- a/Network/TLS/MAC.hs
+++ b/Network/TLS/MAC.hs
@@ -1,77 +1,83 @@
--- |
--- Module      : Network.TLS.MAC
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.MAC
-    ( hmacMD5
-    , hmacSHA1
-    , hmacSHA256
-    , macSSL
-    , hmac
-    , prf_MD5
-    , prf_SHA1
-    , prf_SHA256
-    , prf_MD5SHA1
-    ) where
-
-import qualified Crypto.Hash.MD5 as MD5
-import qualified Crypto.Hash.SHA1 as SHA1
-import qualified Crypto.Hash.SHA256 as SHA256
-import qualified Data.ByteString as B
-import Data.ByteString (ByteString)
-import Data.Bits (xor)
+module Network.TLS.MAC (
+    macSSL,
+    hmac,
+    prf_MD5,
+    prf_SHA1,
+    prf_SHA256,
+    prf_TLS,
+    prf_MD5SHA1,
+    PRF,
+) where
 
-type HMAC = ByteString -> ByteString -> ByteString
+import Data.ByteArray (ByteArray, ByteArrayAccess)
+import qualified Data.ByteArray as BA
 
-macSSL :: (ByteString -> ByteString) -> HMAC
-macSSL f secret msg = f $! B.concat [ secret, B.replicate padlen 0x5c,
-                        f $! B.concat [ secret, B.replicate padlen 0x36, msg ] ]
-  where -- get the type of algorithm out of the digest length by using the hash fct.
-        padlen = if (B.length $ f B.empty) == 16 then 48 else 40
+import Network.TLS.Crypto
+import Network.TLS.Imports
+import Network.TLS.Types
 
-hmac :: (ByteString -> ByteString) -> Int -> HMAC
-hmac f bl secret msg =
-    f $! B.append opad (f $! B.append ipad msg)
-  where opad = B.map (xor 0x5c) k'
-        ipad = B.map (xor 0x36) k'
+type HMAC = Secret -> ByteString -> Secret
 
-        k' = B.append kt pad
-          where kt  = if B.length secret > fromIntegral bl then f secret else secret
-                pad = B.replicate (fromIntegral bl - B.length kt) 0
+macSSL :: Hash -> HMAC
+macSSL alg secret msg =
+    f $
+        BA.concat
+            [ secret
+            , BA.replicate padLen 0x5c
+            , f $ BA.concat [secret, BA.replicate padLen 0x36, BA.convert msg]
+            ]
+  where
+    padLen = case alg of
+        MD5 -> 48
+        SHA1 -> 40
+        _ -> error ("internal error: macSSL called with " ++ show alg)
+    f = hash alg
 
-hmacMD5 :: HMAC
-hmacMD5 secret msg = hmac MD5.hash 64 secret msg
+hmac :: (ByteArray ba, ByteArrayAccess ba) => Hash -> ba -> ByteString -> ba
+hmac alg secret msg = f $ BA.append opad (f $ BA.append ipad $ BA.convert msg)
+  where
+    opad = BA.map (0x5c `xor`) k'
+    ipad = BA.map (0x36 `xor`) k'
 
-hmacSHA1 :: HMAC
-hmacSHA1 secret msg = hmac SHA1.hash 64 secret msg
+    f = hash alg
+    bl = hashBlockSize alg
 
-hmacSHA256 :: HMAC
-hmacSHA256 secret msg = hmac SHA256.hash 64 secret msg
+    k' = BA.append kt pad
+      where
+        kt = if BA.length secret > fromIntegral bl then f secret else secret
+        pad = BA.replicate (fromIntegral bl - BA.length kt) 0
 
-hmacIter :: HMAC -> ByteString -> ByteString -> ByteString -> Int -> [ByteString]
+hmacIter
+    :: HMAC -> Secret -> ByteString -> ByteString -> Int -> [Secret]
 hmacIter f secret seed aprev len =
-    let an = f secret aprev in
-    let out = f secret (B.concat [an, seed]) in
-    let digestsize = fromIntegral $ B.length out in
-    if digestsize >= len
-        then [ B.take (fromIntegral len) out ]
-        else out : hmacIter f secret seed an (len - digestsize)
+    let an = f secret aprev
+     in let out = f secret (BA.concat [an, BA.convert seed])
+         in let digestsize = BA.length out
+             in if digestsize >= len
+                    then [BA.take (fromIntegral len) out]
+                    else out : hmacIter f secret seed (BA.convert an) (len - digestsize)
 
-prf_SHA1 :: ByteString -> ByteString -> Int -> ByteString
-prf_SHA1 secret seed len = B.concat $ hmacIter hmacSHA1 secret seed seed len
+type PRF = Secret -> ByteString -> Int -> Secret
 
-prf_MD5 :: ByteString -> ByteString -> Int -> ByteString
-prf_MD5 secret seed len = B.concat $ hmacIter hmacMD5 secret seed seed len
+prf_SHA1 :: PRF
+prf_SHA1 secret seed len = BA.concat $ hmacIter (hmac SHA1) secret seed seed len
 
-prf_MD5SHA1 :: ByteString -> ByteString -> Int -> ByteString
+prf_MD5 :: PRF
+prf_MD5 secret seed len = BA.concat $ hmacIter (hmac MD5) secret seed seed len
+
+prf_MD5SHA1 :: PRF
 prf_MD5SHA1 secret seed len =
-    B.pack $ B.zipWith xor (prf_MD5 s1 seed len) (prf_SHA1 s2 seed len)
-  where slen  = B.length secret
-        s1    = B.take (slen `div` 2 + slen `mod` 2) secret
-        s2    = B.drop (slen `div` 2) secret
+    BA.xor (prf_MD5 s1 seed len) (prf_SHA1 s2 seed len)
+  where
+    slen = BA.length secret
+    s1 = BA.take (slen `div` 2 + slen `mod` 2) secret
+    s2 = BA.drop (slen `div` 2) secret
 
-prf_SHA256 :: ByteString -> ByteString -> Int -> ByteString
-prf_SHA256 secret seed len = B.concat $ hmacIter hmacSHA256 secret seed seed len
+prf_SHA256 :: PRF
+prf_SHA256 secret seed len = BA.concat $ hmacIter (hmac SHA256) secret seed seed len
+
+-- | For now we ignore the version, but perhaps some day the PRF will depend
+-- not only on the cipher PRF algorithm, but also on the protocol version.
+prf_TLS :: Version -> Hash -> PRF
+prf_TLS _ halg secret seed len =
+    BA.concat $ hmacIter (hmac halg) secret seed seed len
diff --git a/Network/TLS/Measurement.hs b/Network/TLS/Measurement.hs
--- a/Network/TLS/Measurement.hs
+++ b/Network/TLS/Measurement.hs
@@ -1,46 +1,44 @@
--- |
--- Module      : Network.TLS.Measurement
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Measurement
-        ( Measurement(..)
-        , newMeasurement
-        , addBytesReceived
-        , addBytesSent
-        , resetBytesCounters
-        , incrementNbHandshakes
-        ) where
+module Network.TLS.Measurement (
+    Measurement (..),
+    newMeasurement,
+    addBytesReceived,
+    addBytesSent,
+    resetBytesCounters,
+    incrementNbHandshakes,
+) where
 
-import Data.Word
+import Network.TLS.Imports
 
 -- | record some data about this connection.
 data Measurement = Measurement
-        { nbHandshakes  :: !Word32 -- ^ number of handshakes on this context
-        , bytesReceived :: !Word32 -- ^ bytes received since last handshake
-        , bytesSent     :: !Word32 -- ^ bytes sent since last handshake
-        } deriving (Show,Eq)
+    { nbHandshakes :: Word32
+    -- ^ number of handshakes on this context
+    , bytesReceived :: Word32
+    -- ^ bytes received since last handshake
+    , bytesSent :: Word32
+    -- ^ bytes sent since last handshake
+    }
+    deriving (Show, Eq)
 
 newMeasurement :: Measurement
-newMeasurement = Measurement
-        { nbHandshakes  = 0
+newMeasurement =
+    Measurement
+        { nbHandshakes = 0
         , bytesReceived = 0
-        , bytesSent     = 0
+        , bytesSent = 0
         }
 
 addBytesReceived :: Int -> Measurement -> Measurement
 addBytesReceived sz measure =
-        measure { bytesReceived = bytesReceived measure + fromIntegral sz }
+    measure{bytesReceived = bytesReceived measure + fromIntegral sz}
 
 addBytesSent :: Int -> Measurement -> Measurement
 addBytesSent sz measure =
-        measure { bytesSent = bytesSent measure + fromIntegral sz }
+    measure{bytesSent = bytesSent measure + fromIntegral sz}
 
 resetBytesCounters :: Measurement -> Measurement
-resetBytesCounters measure = measure { bytesReceived = 0, bytesSent = 0 }
+resetBytesCounters measure = measure{bytesReceived = 0, bytesSent = 0}
 
 incrementNbHandshakes :: Measurement -> Measurement
 incrementNbHandshakes measure =
-        measure { nbHandshakes = nbHandshakes measure + 1 }
+    measure{nbHandshakes = nbHandshakes measure + 1}
diff --git a/Network/TLS/Packet.hs b/Network/TLS/Packet.hs
--- a/Network/TLS/Packet.hs
+++ b/Network/TLS/Packet.hs
@@ -1,407 +1,441 @@
 {-# LANGUAGE OverloadedStrings #-}
--- |
--- Module      : Network.TLS.Packet
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- the Packet module contains everything necessary to serialize and deserialize things
--- with only explicit parameters, no TLS state is involved here.
---
-module Network.TLS.Packet
-    (
+{-# LANGUAGE RecordWildCards #-}
+
+-- | The Packet module contains everything necessary to serialize and
+--  deserialize things with only explicit parameters, no TLS state is
+--  involved here.
+module Network.TLS.Packet (
     -- * params for encoding and decoding
-      CurrentParams(..)
+    CurrentParams (..),
+
     -- * marshall functions for header messages
-    , decodeHeader
-    , decodeDeprecatedHeaderLength
-    , decodeDeprecatedHeader
-    , encodeHeader
-    , encodeHeaderNoVer -- use for SSL3
+    decodeHeader,
+    encodeHeader,
 
     -- * marshall functions for alert messages
-    , decodeAlert
-    , decodeAlerts
-    , encodeAlerts
+    decodeAlert,
+    decodeAlerts,
+    encodeAlerts,
 
     -- * marshall functions for handshake messages
-    , decodeHandshakeRecord
-    , decodeHandshake
-    , decodeDeprecatedHandshake
-    , encodeHandshake
-    , encodeHandshakes
-    , encodeHandshakeHeader
-    , encodeHandshakeContent
+    decodeHandshakeRecord,
+    decodeHandshake,
+    encodeHandshake,
+    encodeHandshake',
+    encodeCertificate,
+    decodeClientHello',
 
     -- * marshall functions for change cipher spec message
-    , decodeChangeCipherSpec
-    , encodeChangeCipherSpec
+    decodeChangeCipherSpec,
+    encodeChangeCipherSpec,
+    decodePreMainSecret,
+    encodePreMainSecret,
+    encodeSignedDHParams,
+    encodeSignedECDHParams,
+    decodeReallyServerKeyXchgAlgorithmData,
 
-    , decodePreMasterSecret
-    , encodePreMasterSecret
-    , encodeSignedDHParams
+    -- * generate things for packet content
+    generateMainSecret,
+    generateExtendedMainSecret,
+    generateKeyBlock,
 
-    , decodeReallyServerKeyXchgAlgorithmData
+    -- * for extensions parsing
+    getSignatureHashAlgorithm,
+    putSignatureHashAlgorithm,
+    getBinaryVersion,
+    putBinaryVersion,
+    getClientRandom32,
+    putClientRandom32,
+    getServerRandom32,
+    putServerRandom32,
+    getExtensions,
+    putExtension,
+    getSession,
+    putSession,
+    putDNames,
+    getDNames,
+    getHandshakeType,
 
-    -- * generate things for packet content
-    , generateMasterSecret
-    , generateKeyBlock
-    , generateClientFinished
-    , generateServerFinished
+    -- * PRF
+    PRF,
+    getPRF,
+) where
 
-    , generateCertificateVerify_SSL
-    ) where
+import Data.ByteArray (ByteArrayAccess, convert)
+import qualified Data.ByteString as B
+import Data.X509 (
+    CertificateChain,
+    CertificateChainRaw (..),
+    decodeCertificateChain,
+    encodeCertificateChain,
+ )
 
-import Network.TLS.Struct
-import Network.TLS.Wire
-import Network.TLS.Cap
-import Data.Maybe (fromJust)
-import Data.Word
-import Control.Applicative ((<$>), (<*>))
-import Control.Monad
-import Data.ASN1.Types (fromASN1, toASN1)
-import Data.ASN1.Encoding (decodeASN1', encodeASN1')
-import Data.ASN1.BinaryEncoding (DER(..))
-import Data.X509 (CertificateChainRaw(..), encodeCertificateChain, decodeCertificateChain)
 import Network.TLS.Crypto
+import Network.TLS.Imports
 import Network.TLS.MAC
-import Network.TLS.Cipher (CipherKeyExchangeType(..))
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
+import Network.TLS.Struct
+import Network.TLS.Types
+import Network.TLS.Util.ASN1
+import Network.TLS.Wire
 
-import qualified Crypto.Hash.SHA1 as SHA1
-import qualified Crypto.Hash.MD5 as MD5
+----------------------------------------------------------------
+-- Header
 
 data CurrentParams = CurrentParams
-    { cParamsVersion     :: Version                     -- ^ current protocol version
-    , cParamsKeyXchgType :: Maybe CipherKeyExchangeType -- ^ current key exchange type
-    , cParamsSupportNPN  :: Bool                        -- ^ support Next Protocol Negotiation extension
-    } deriving (Show,Eq)
+    { cParamsVersion :: Version
+    -- ^ current protocol version
+    , cParamsKeyXchgType :: Maybe CipherKeyExchangeType
+    -- ^ current key exchange type
+    }
+    deriving (Show, Eq)
 
-{- marshall helpers -}
-getVersion :: Get Version
-getVersion = do
-    major <- getWord8
-    minor <- getWord8
-    case verOfNum (major, minor) of
-        Nothing -> fail ("invalid version : " ++ show major ++ "," ++ show minor)
-        Just v  -> return v
+-- marshall helpers
+getBinaryVersion :: Get Version
+getBinaryVersion = Version <$> getWord16
 
-putVersion :: Version -> Put
-putVersion ver = putWord8 major >> putWord8 minor
-  where (major, minor) = numericalVer ver
+putBinaryVersion :: Version -> Put
+putBinaryVersion (Version ver) = putWord16 ver
 
 getHeaderType :: Get ProtocolType
-getHeaderType = do
-    ty <- getWord8
-    case valToType ty of
-        Nothing -> fail ("invalid header type: " ++ show ty)
-        Just t  -> return t
+getHeaderType = ProtocolType <$> getWord8
 
 putHeaderType :: ProtocolType -> Put
-putHeaderType = putWord8 . valOfType
+putHeaderType (ProtocolType pt) = putWord8 pt
 
 getHandshakeType :: Get HandshakeType
-getHandshakeType = do
-    ty <- getWord8
-    case valToType ty of
-        Nothing -> fail ("invalid handshake type: " ++ show ty)
-        Just t  -> return t
+getHandshakeType = HandshakeType <$> getWord8
 
-{-
- - decode and encode headers
- -}
+-- decode and encode headers
 decodeHeader :: ByteString -> Either TLSError Header
-decodeHeader = runGetErr "header" $ liftM3 Header getHeaderType getVersion getWord16
+decodeHeader =
+    runGetErr "header" $ Header <$> getHeaderType <*> getBinaryVersion <*> getWord16
 
-decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16
-decodeDeprecatedHeaderLength = runGetErr "deprecatedheaderlength" $ subtract 0x8000 <$> getWord16
+encodeHeader :: Header -> ByteString
+encodeHeader (Header pt ver len) = runPut (putHeaderType pt >> putBinaryVersion ver >> putWord16 len)
 
-decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header
-decodeDeprecatedHeader size =
-    runGetErr "deprecatedheader" $ do
-        1 <- getWord8
-        version <- getVersion
-        return $ Header ProtocolType_DeprecatedHandshake version size
+-- FIXME check len <= 2^14
 
-encodeHeader :: Header -> ByteString
-encodeHeader (Header pt ver len) = runPut (putHeaderType pt >> putVersion ver >> putWord16 len)
-        {- FIXME check len <= 2^14 -}
+------------------------------------------------------------
+-- CCS
 
-encodeHeaderNoVer :: Header -> ByteString
-encodeHeaderNoVer (Header pt _ len) = runPut (putHeaderType pt >> putWord16 len)
-        {- FIXME check len <= 2^14 -}
+decodeChangeCipherSpec :: ByteString -> Either TLSError ()
+decodeChangeCipherSpec = runGetErr "changecipherspec" $ do
+    x <- getWord8
+    when (x /= 1) $ fail "unknown change cipher spec content"
+    len <- remaining
+    when (len /= 0) $ fail "the length of CSS must be 1"
 
-{-
- - decode and encode ALERT
- -}
+encodeChangeCipherSpec :: ByteString
+encodeChangeCipherSpec = runPut (putWord8 1)
+
+----------------------------------------------------------------
+-- Alert
+
 decodeAlert :: Get (AlertLevel, AlertDescription)
 decodeAlert = do
-    al <- getWord8
-    ad <- getWord8
-    case (valToType al, valToType ad) of
-        (Just a, Just d) -> return (a, d)
-        (Nothing, _)     -> fail "cannot decode alert level"
-        (_, Nothing)     -> fail "cannot decode alert description"
+    al <- AlertLevel <$> getWord8
+    ad <- AlertDescription <$> getWord8
+    return (al, ad)
 
 decodeAlerts :: ByteString -> Either TLSError [(AlertLevel, AlertDescription)]
-decodeAlerts = runGetErr "alerts" $ loop
-  where loop = do
-            r <- remaining
-            if r == 0
-                then return []
-                else liftM2 (:) decodeAlert loop
+decodeAlerts = runGetErr "alerts" loop
+  where
+    loop = do
+        r <- remaining
+        if r == 0
+            then return []
+            else (:) <$> decodeAlert <*> loop
 
 encodeAlerts :: [(AlertLevel, AlertDescription)] -> ByteString
 encodeAlerts l = runPut $ mapM_ encodeAlert l
-  where encodeAlert (al, ad) = putWord8 (valOfType al) >> putWord8 (valOfType ad)
+  where
+    encodeAlert (al, ad) = putWord8 (fromAlertLevel al) >> putWord8 (fromAlertDescription ad)
 
-{- decode and encode HANDSHAKE -}
-decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, Bytes)
+----------------------------------------------------------------
+-- decode HANDSHAKE
+
+decodeHandshakeRecord :: ByteString -> GetResult (HandshakeType, ByteString)
 decodeHandshakeRecord = runGet "handshake-record" $ do
-    ty      <- getHandshakeType
+    ty <- getHandshakeType
     content <- getOpaque24
     return (ty, content)
 
-decodeHandshake :: CurrentParams -> HandshakeType -> ByteString -> Either TLSError Handshake
+{- FOURMOLU_DISABLE -}
+decodeHandshake
+    :: CurrentParams -> HandshakeType -> ByteString -> Either TLSError Handshake
 decodeHandshake cp ty = runGetErr ("handshake[" ++ show ty ++ "]") $ case ty of
-    HandshakeType_HelloRequest    -> decodeHelloRequest
-    HandshakeType_ClientHello     -> decodeClientHello
-    HandshakeType_ServerHello     -> decodeServerHello
-    HandshakeType_Certificate     -> decodeCertificates
-    HandshakeType_ServerKeyXchg   -> decodeServerKeyXchg cp
-    HandshakeType_CertRequest     -> decodeCertRequest cp
-    HandshakeType_ServerHelloDone -> decodeServerHelloDone
-    HandshakeType_CertVerify      -> decodeCertVerify cp
-    HandshakeType_ClientKeyXchg   -> decodeClientKeyXchg cp
-    HandshakeType_Finished        -> decodeFinished
-    HandshakeType_NPN             -> do
-        unless (cParamsSupportNPN cp) $ fail "unsupported handshake type"
-        decodeNextProtocolNegotiation
-
-decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake
-decodeDeprecatedHandshake b = runGetErr "deprecatedhandshake" getDeprecated b
-  where getDeprecated = do
-            1 <- getWord8
-            ver <- getVersion
-            cipherSpecLen <- fromEnum <$> getWord16
-            sessionIdLen <- fromEnum <$> getWord16
-            challengeLen <- fromEnum <$> getWord16
-            ciphers <- getCipherSpec cipherSpecLen
-            session <- getSessionId sessionIdLen
-            random <- getChallenge challengeLen
-            let compressions = [0]
-            return $ ClientHello ver random session ciphers compressions [] (Just b)
-        getCipherSpec len | len < 3 = return []
-        getCipherSpec len = do
-            [c0,c1,c2] <- map fromEnum <$> replicateM 3 getWord8
-            ([ toEnum $ c1 * 0x100 + c2 | c0 == 0 ] ++) <$> getCipherSpec (len - 3)
-        getSessionId 0 = return $ Session Nothing
-        getSessionId len = Session . Just <$> getBytes len
-        getChallenge len | 32 < len = getBytes (len - 32) >> getChallenge 32
-        getChallenge len = ClientRandom . B.append (B.replicate (32 - len) 0) <$> getBytes len
+    HandshakeType_HelloRequest     -> decodeHelloRequest
+    HandshakeType_ClientHello      -> decodeClientHello False
+    HandshakeType_ServerHello      -> decodeServerHello
+    HandshakeType_NewSessionTicket -> decodeNewSessionTicket
+    HandshakeType_Certificate      -> decodeCertificate
+    HandshakeType_ServerKeyXchg    -> decodeServerKeyXchg cp
+    HandshakeType_CertRequest      -> decodeCertRequest cp
+    HandshakeType_ServerHelloDone  -> decodeServerHelloDone
+    HandshakeType_CertVerify       -> decodeCertVerify cp
+    HandshakeType_ClientKeyXchg    -> decodeClientKeyXchg cp
+    HandshakeType_Finished         -> decodeFinished
+    x -> fail $ "Unsupported HandshakeType " ++ show x
+{- FOURMOLU_ENABLE -}
 
 decodeHelloRequest :: Get Handshake
 decodeHelloRequest = return HelloRequest
 
-decodeClientHello :: Get Handshake
-decodeClientHello = do
-    ver          <- getVersion
-    random       <- getClientRandom32
-    session      <- getSession
-    ciphers      <- getWords16
+decodeClientHello' :: ByteString -> Either TLSError Handshake
+decodeClientHello' = runGetErr "decodeClientHello'" $ decodeClientHello True
+
+decodeClientHello :: Bool -> Get Handshake
+decodeClientHello inner = do
+    ver <- getBinaryVersion
+    random <- getClientRandom32
+    session <- getSession
+    ciphers <- map CipherId <$> getWords16
     compressions <- getWords8
-    r            <- remaining
-    exts <- if hasHelloExtensions ver && r > 0
-            then fmap fromIntegral getWord16 >>= getExtensions
+    r <- remaining
+    exts <-
+        if r > 0
+            then getWord16 >>= getExtensions . fromIntegral
             else return []
-    return $ ClientHello ver random session ciphers compressions exts Nothing
+    r1 <- remaining
+    if inner
+        then
+            checkAndSkip r1
+        else when (r1 /= 0) $ fail "Client hello has garbage"
+    return $
+        ClientHello $
+            CH
+                { chVersion = ver
+                , chRandom = random
+                , chSession = session
+                , chCiphers = ciphers
+                , chComps = compressions
+                , chExtensions = exts
+                }
+  where
+    checkAndSkip 0 = return ()
+    checkAndSkip r = do
+        zero <- getWord8
+        when (zero /= 0) $ fail "Inner client hello has garbage"
+        checkAndSkip (r - 1)
 
 decodeServerHello :: Get Handshake
 decodeServerHello = do
-    ver           <- getVersion
-    random        <- getServerRandom32
-    session       <- getSession
-    cipherid      <- getWord16
+    ver <- getBinaryVersion
+    random <- getServerRandom32
+    session <- getSession
+    cipherid <- CipherId <$> getWord16
     compressionid <- getWord8
-    r             <- remaining
-    exts <- if hasHelloExtensions ver && r > 0
-            then fmap fromIntegral getWord16 >>= getExtensions
+    r <- remaining
+    exts <-
+        if r > 0
+            then getWord16 >>= getExtensions . fromIntegral
             else return []
-    return $ ServerHello ver random session cipherid compressionid exts
+    return $
+        ServerHello $
+            SH
+                { shVersion = ver
+                , shRandom = random
+                , shSession = session
+                , shCipher = cipherid
+                , shComp = compressionid
+                , shExtensions = exts
+                }
 
-decodeServerHelloDone :: Get Handshake
-decodeServerHelloDone = return ServerHelloDone
+decodeNewSessionTicket :: Get Handshake
+decodeNewSessionTicket = NewSessionTicket <$> getWord32 <*> getOpaque16
 
-decodeCertificates :: Get Handshake
-decodeCertificates = do
-    certsRaw <- CertificateChainRaw <$> (getWord24 >>= \len -> getList (fromIntegral len) getCertRaw)
+decodeCertificate :: Get Handshake
+decodeCertificate = do
+    certsRaw <-
+        CertificateChainRaw
+            <$> (getWord24 >>= \len -> getList (fromIntegral len) getCertRaw)
     case decodeCertificateChain certsRaw of
         Left (i, s) -> fail ("error certificate parsing " ++ show i ++ ":" ++ s)
-        Right cc    -> return $ Certificates cc
-  where getCertRaw = getOpaque24 >>= \cert -> return (3 + B.length cert, cert)
+        Right cc -> return $ Certificate $ CertificateChain_ cc
+  where
+    getCertRaw = getOpaque24 >>= \cert -> return (3 + B.length cert, cert)
 
-decodeFinished :: Get Handshake
-decodeFinished = Finished <$> (remaining >>= getBytes)
+----
 
-decodeNextProtocolNegotiation :: Get Handshake
-decodeNextProtocolNegotiation = do
-    opaque <- getOpaque8
-    _      <- getOpaque8 -- ignore padding
-    return $ HsNextProtocolNegotiation opaque
+decodeServerKeyXchg :: CurrentParams -> Get Handshake
+decodeServerKeyXchg cp =
+    case cParamsKeyXchgType cp of
+        Just cke -> ServerKeyXchg <$> decodeServerKeyXchgAlgorithmData (cParamsVersion cp) cke
+        Nothing -> ServerKeyXchg . SKX_Unparsed <$> (remaining >>= getBytes)
 
+decodeServerKeyXchgAlgorithmData
+    :: Version
+    -> CipherKeyExchangeType
+    -> Get ServerKeyXchgAlgorithmData
+decodeServerKeyXchgAlgorithmData ver cke = toCKE
+  where
+    toCKE = case cke of
+        CipherKeyExchange_RSA -> SKX_RSA . Just <$> decodeServerKeyXchg_RSA
+        CipherKeyExchange_DH_Anon -> SKX_DH_Anon <$> decodeServerKeyXchg_DH
+        CipherKeyExchange_DHE_RSA -> do
+            dhparams <- getServerDHParams
+            signature <- getDigitallySigned ver
+            return $ SKX_DHE_RSA dhparams signature
+        CipherKeyExchange_DHE_DSA -> do
+            dhparams <- getServerDHParams
+            signature <- getDigitallySigned ver
+            return $ SKX_DHE_DSA dhparams signature
+        CipherKeyExchange_ECDHE_RSA -> do
+            ecdhparams <- getServerECDHParams
+            signature <- getDigitallySigned ver
+            return $ SKX_ECDHE_RSA ecdhparams signature
+        CipherKeyExchange_ECDHE_ECDSA -> do
+            ecdhparams <- getServerECDHParams
+            signature <- getDigitallySigned ver
+            return $ SKX_ECDHE_ECDSA ecdhparams signature
+        _ -> do
+            bs <- remaining >>= getBytes
+            return $ SKX_Unknown bs
+
+decodeServerKeyXchg_DH :: Get ServerDHParams
+decodeServerKeyXchg_DH = getServerDHParams
+
+-- We don't support ECDH_Anon at this moment
+-- decodeServerKeyXchg_ECDH :: Get ServerECDHParams
+
+decodeServerKeyXchg_RSA :: Get ServerRSAParams
+decodeServerKeyXchg_RSA =
+    ServerRSAParams
+        <$> getInteger16 -- modulus
+        <*> getInteger16 -- exponent
+
+----
+
 decodeCertRequest :: CurrentParams -> Get Handshake
-decodeCertRequest cp = do
-    certTypes <- map (fromJust . valToType . fromIntegral) <$> getWords8
+decodeCertRequest _cp = do
+    certTypes <- map CertificateType <$> getWords8
+    sigHashAlgs <- getWord16 >>= getSignatureHashAlgorithms
+    CertRequest certTypes sigHashAlgs <$> getDNames
+  where
+    getSignatureHashAlgorithms len =
+        getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))
 
-    sigHashAlgs <- if cParamsVersion cp >= TLS12
-                       then Just <$> (getWord16 >>= getSignatureHashAlgorithms)
-                       else return Nothing
-    dNameLen <- getWord16
-    -- FIXME: Decide whether to remove this check completely or to make it an option.
-    -- when (cParamsVersion cp < TLS12 && dNameLen < 3) $ fail "certrequest distinguishname not of the correct size"
-    dNames <- getList (fromIntegral dNameLen) getDName
-    return $ CertRequest certTypes sigHashAlgs dNames
-  where getSignatureHashAlgorithms len = getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh))
-        getDName = do
-            dName <- getOpaque16
-            when (B.length dName == 0) $ fail "certrequest: invalid DN length"
-            dn <- case decodeASN1' DER dName of
-                    Left e      -> fail ("cert request decoding DistinguishedName ASN1 failed: " ++ show e)
-                    Right asn1s -> case fromASN1 asn1s of
-                                        Left e      -> fail ("cert request parsing DistinguishedName ASN1 failed: " ++ show e)
-                                        Right (d,_) -> return d
-            return (2 + B.length dName, dn)
+----
 
+decodeServerHelloDone :: Get Handshake
+decodeServerHelloDone = return ServerHelloDone
+
 decodeCertVerify :: CurrentParams -> Get Handshake
 decodeCertVerify cp = CertVerify <$> getDigitallySigned (cParamsVersion cp)
 
 decodeClientKeyXchg :: CurrentParams -> Get Handshake
-decodeClientKeyXchg cp = -- case  ClientKeyXchg <$> (remaining >>= getBytes)
+decodeClientKeyXchg cp =
+    -- case  ClientKeyXchg <$> (remaining >>= getBytes)
     case cParamsKeyXchgType cp of
-        Nothing  -> error "no client key exchange type"
+        Nothing -> fail "no client key exchange type"
         Just cke -> ClientKeyXchg <$> parseCKE cke
-  where parseCKE CipherKeyExchange_RSA     = CKX_RSA <$> (remaining >>= getBytes)
-        parseCKE CipherKeyExchange_DHE_RSA = parseClientDHPublic
-        parseCKE CipherKeyExchange_DHE_DSS = parseClientDHPublic
-        parseCKE CipherKeyExchange_DH_Anon = parseClientDHPublic
-        parseCKE _                         = error "unsupported client key exchange type"
-        parseClientDHPublic = CKX_DH . dhPublic <$> getInteger16
-
-decodeServerKeyXchg_DH :: Get ServerDHParams
-decodeServerKeyXchg_DH = getServerDHParams
-
-decodeServerKeyXchg_RSA :: Get ServerRSAParams
-decodeServerKeyXchg_RSA = ServerRSAParams <$> getInteger16 -- modulus
-                                          <*> getInteger16 -- exponent
+  where
+    parseCKE CipherKeyExchange_RSA = CKX_RSA <$> (remaining >>= getBytes)
+    parseCKE CipherKeyExchange_DHE_RSA = parseClientDHPublic
+    parseCKE CipherKeyExchange_DHE_DSA = parseClientDHPublic
+    parseCKE CipherKeyExchange_DH_Anon = parseClientDHPublic
+    parseCKE CipherKeyExchange_ECDHE_RSA = parseClientECDHPublic
+    parseCKE CipherKeyExchange_ECDHE_ECDSA = parseClientECDHPublic
+    parseCKE _ = fail "unsupported client key exchange type"
+    parseClientDHPublic = CKX_DH . dhPublic <$> getInteger16
+    parseClientECDHPublic = CKX_ECDH <$> getOpaque8
 
-decodeServerKeyXchgAlgorithmData :: Version
-                                 -> CipherKeyExchangeType
-                                 -> Get ServerKeyXchgAlgorithmData
-decodeServerKeyXchgAlgorithmData ver cke = toCKE
-  where toCKE = case cke of
-            CipherKeyExchange_RSA     -> SKX_RSA . Just <$> decodeServerKeyXchg_RSA
-            CipherKeyExchange_DH_Anon -> SKX_DH_Anon <$> decodeServerKeyXchg_DH
-            CipherKeyExchange_DHE_RSA -> do
-                dhparams  <- getServerDHParams
-                signature <- getDigitallySigned ver
-                return $ SKX_DHE_RSA dhparams signature
-            CipherKeyExchange_DHE_DSS -> do
-                dhparams  <- getServerDHParams
-                signature <- getDigitallySigned ver
-                return $ SKX_DHE_DSS dhparams signature
-            _ -> do
-                bs <- remaining >>= getBytes
-                return $ SKX_Unknown bs
+decodeFinished :: Get Handshake
+decodeFinished = Finished . VerifyData <$> (remaining >>= getBytes)
 
-decodeServerKeyXchg :: CurrentParams -> Get Handshake
-decodeServerKeyXchg cp =
-    case cParamsKeyXchgType cp of
-        Just cke -> ServerKeyXchg <$> decodeServerKeyXchgAlgorithmData (cParamsVersion cp) cke
-        Nothing  -> ServerKeyXchg . SKX_Unparsed <$> (remaining >>= getBytes)
+----------------------------------------------------------------
+-- encode HANDSHAKE
 
 encodeHandshake :: Handshake -> ByteString
 encodeHandshake o =
-    let content = runPut $ encodeHandshakeContent o in
-    let len = fromIntegral $ B.length content in
-    let header = case o of
-                    ClientHello _ _ _ _ _ _ (Just _) -> "" -- SSLv2 ClientHello message
-                    _ -> runPut $ encodeHandshakeHeader (typeOfHandshake o) len in
-    B.concat [ header, content ]
-
-encodeHandshakes :: [Handshake] -> ByteString
-encodeHandshakes hss = B.concat $ map encodeHandshake hss
+    let content = encodeHandshake' o
+     in let len = B.length content
+         in let header = runPut $ encodeHandshakeHeader (typeOfHandshake o) len
+             in B.concat [header, content]
 
 encodeHandshakeHeader :: HandshakeType -> Int -> Put
-encodeHandshakeHeader ty len = putWord8 (valOfType ty) >> putWord24 len
-
-encodeHandshakeContent :: Handshake -> Put
-
-encodeHandshakeContent (ClientHello _ _ _ _ _ _ (Just deprecated)) = do
-    putBytes deprecated
-encodeHandshakeContent (ClientHello version random session cipherIDs compressionIDs exts Nothing) = do
-    putVersion version
-    putClientRandom32 random
-    putSession session
-    putWords16 cipherIDs
-    putWords8 compressionIDs
-    putExtensions exts
-    return ()
-
-encodeHandshakeContent (ServerHello version random session cipherID compressionID exts) =
-    putVersion version >> putServerRandom32 random >> putSession session
-                       >> putWord16 cipherID >> putWord8 compressionID
-                       >> putExtensions exts >> return ()
-
-encodeHandshakeContent (Certificates cc) = putOpaque24 (runPut $ mapM_ putOpaque24 certs)
-  where (CertificateChainRaw certs) = encodeCertificateChain cc
-
-encodeHandshakeContent (ClientKeyXchg ckx) = do
-    case ckx of
-        CKX_RSA encryptedPreMaster -> putBytes encryptedPreMaster
-        CKX_DH clientDHPublic      -> putInteger16 $ dhUnwrapPublic clientDHPublic
+encodeHandshakeHeader ty len = putWord8 (fromHandshakeType ty) >> putWord24 len
 
-encodeHandshakeContent (ServerKeyXchg skg) =
+encodeHandshake' :: Handshake -> ByteString
+encodeHandshake' HelloRequest = ""
+encodeHandshake' (ClientHello CH{..}) = runPut $ do
+    putBinaryVersion chVersion
+    putClientRandom32 chRandom
+    putSession chSession
+    putWords16 $ map fromCipherId chCiphers
+    putWords8 chComps
+    putExtensions chExtensions
+encodeHandshake' (ServerHello SH{..}) = runPut $ do
+    putBinaryVersion shVersion
+    putServerRandom32 shRandom
+    putSession shSession
+    putWord16 $ fromCipherId shCipher
+    putWord8 shComp
+    putExtensions shExtensions
+encodeHandshake' (NewSessionTicket life ticket) = runPut $ do
+    putWord32 life
+    putOpaque16 ticket
+encodeHandshake' (Certificate (CertificateChain_ cc)) = encodeCertificate cc
+encodeHandshake' (ServerKeyXchg skg) = runPut $
     case skg of
-        SKX_RSA _              -> error "encodeHandshakeContent SKX_RSA not implemented"
-        SKX_DH_Anon params     -> putServerDHParams params
+        SKX_RSA _ -> error "encodeHandshake' SKX_RSA not implemented"
+        SKX_DH_Anon params -> putServerDHParams params
         SKX_DHE_RSA params sig -> putServerDHParams params >> putDigitallySigned sig
-        SKX_DHE_DSS params sig -> putServerDHParams params >> putDigitallySigned sig
-        SKX_Unparsed bytes     -> putBytes bytes
-        _                      -> error ("encodeHandshakeContent: cannot handle: " ++ show skg)
-
-encodeHandshakeContent (HelloRequest) = return ()
-encodeHandshakeContent (ServerHelloDone) = return ()
-
-encodeHandshakeContent (CertRequest certTypes sigAlgs certAuthorities) = do
-    putWords8 (map valOfType certTypes)
-    case sigAlgs of
-        Nothing -> return ()
-        Just l  -> putWords16 $ map (\(x,y) -> (fromIntegral $ valOfType x) * 256 + (fromIntegral $ valOfType y)) l
-    encodeCertAuthorities certAuthorities
-  where -- Convert a distinguished name to its DER encoding.
-        encodeCA dn = return $ encodeASN1' DER (toASN1 dn []) --B.concat $ L.toChunks $ encodeDN dn
+        SKX_DHE_DSA params sig -> putServerDHParams params >> putDigitallySigned sig
+        SKX_ECDHE_RSA params sig -> putServerECDHParams params >> putDigitallySigned sig
+        SKX_ECDHE_ECDSA params sig -> putServerECDHParams params >> putDigitallySigned sig
+        SKX_Unparsed bytes -> putBytes bytes
+        _ -> error ("encodeHandshake': cannot handle: " ++ show skg)
+encodeHandshake' (CertRequest certTypes sigAlgs certAuthorities) = runPut $ do
+    putWords8 (map fromCertificateType certTypes)
+    putWords16 $
+        map
+            ( \(HashAlgorithm x, SignatureAlgorithm y) -> fromIntegral x * 256 + fromIntegral y
+            )
+            sigAlgs
+    putDNames certAuthorities
+encodeHandshake' ServerHelloDone = ""
+encodeHandshake' (CertVerify digitallySigned) = runPut $ putDigitallySigned digitallySigned
+encodeHandshake' (ClientKeyXchg ckx) = runPut $ do
+    case ckx of
+        CKX_RSA encryptedPreMain -> putBytes encryptedPreMain
+        CKX_DH clientDHPublic -> putInteger16 $ dhUnwrapPublic clientDHPublic
+        CKX_ECDH bytes -> putOpaque8 bytes
+encodeHandshake' (Finished (VerifyData opaque)) = runPut $ putBytes opaque
 
-        -- Encode a list of distinguished names.
-        encodeCertAuthorities certAuths = do
-            enc <- mapM encodeCA certAuths
-            let totLength = sum $ map (((+) 2) . B.length) enc
-            putWord16 (fromIntegral totLength)
-            mapM_ (\ b -> putWord16 (fromIntegral (B.length b)) >> putBytes b) enc
+------------------------------------------------------------
+-- CA distinguished names
 
-encodeHandshakeContent (CertVerify digitallySigned) = putDigitallySigned digitallySigned
+-- | Decode a list CA distinguished names
+getDNames :: Get [DistinguishedName]
+getDNames = do
+    dNameLen <- getWord16
+    -- FIXME: Decide whether to remove this check completely or to make it an option.
+    -- when (cParamsVersion cp < TLS12 && dNameLen < 3) $ fail "certrequest distinguishname not of the correct size"
+    getList (fromIntegral dNameLen) getDName
+  where
+    getDName = do
+        dName <- getOpaque16
+        when (B.length dName == 0) $ fail "certrequest: invalid DN length"
+        dn <-
+            either fail return $ decodeASN1Object "cert request DistinguishedName" dName
+        return (2 + B.length dName, dn)
 
-encodeHandshakeContent (Finished opaque) = putBytes opaque
+-- | Encode a list of distinguished names.
+putDNames :: [DistinguishedName] -> Put
+putDNames dnames = do
+    enc <- mapM encodeCA dnames
+    let totLength = sum $ map ((+) 2 . B.length) enc
+    putWord16 (fromIntegral totLength)
+    mapM_ (\b -> putWord16 (fromIntegral (B.length b)) >> putBytes b) enc
+  where
+    -- Convert a distinguished name to its DER encoding.
+    encodeCA dn = return $ encodeASN1Object dn
 
-encodeHandshakeContent (HsNextProtocolNegotiation protocol) = do
-    putOpaque8 protocol
-    putOpaque8 $ B.replicate paddingLen 0
-  where paddingLen = 32 - ((B.length protocol + 2) `mod` 32)
+------------------------------------------------------------
 
 {- FIXME make sure it return error if not 32 available -}
-getRandom32 :: Get Bytes
+getRandom32 :: Get ByteString
 getRandom32 = getBytes 32
 
 getServerRandom32 :: Get ServerRandom
@@ -410,7 +444,7 @@
 getClientRandom32 :: Get ClientRandom
 getClientRandom32 = ClientRandom <$> getRandom32
 
-putRandom32 :: Bytes -> Put
+putRandom32 :: ByteString -> Put
 putRandom32 = putBytes
 
 putClientRandom32 :: ClientRandom -> Put
@@ -419,166 +453,199 @@
 putServerRandom32 :: ServerRandom -> Put
 putServerRandom32 (ServerRandom r) = putRandom32 r
 
+------------------------------------------------------------
+
 getSession :: Get Session
 getSession = do
     len8 <- getWord8
     case fromIntegral len8 of
-        0   -> return $ Session Nothing
-        len -> Session . Just <$> getBytes len
+        0 -> return $ Session Nothing
+        len
+            | len > 32 -> fail "the length of session id must be <= 32"
+            | otherwise -> Session . Just <$> getBytes len
 
 putSession :: Session -> Put
-putSession (Session Nothing)  = putWord8 0
+putSession (Session Nothing) = putWord8 0
 putSession (Session (Just s)) = putOpaque8 s
 
+------------------------------------------------------------
+
 getExtensions :: Int -> Get [ExtensionRaw]
-getExtensions 0   = return []
+getExtensions 0 = return []
 getExtensions len = do
-    extty <- getWord16
+    extty <- ExtensionID <$> getWord16
     extdatalen <- getWord16
     extdata <- getBytes $ fromIntegral extdatalen
     extxs <- getExtensions (len - fromIntegral extdatalen - 4)
-    return $ (extty, extdata) : extxs
+    return $ ExtensionRaw extty extdata : extxs
 
 putExtension :: ExtensionRaw -> Put
-putExtension (ty, l) = putWord16 ty >> putOpaque16 l
+putExtension (ExtensionRaw (ExtensionID ty) l) = putWord16 ty >> putOpaque16 l
 
 putExtensions :: [ExtensionRaw] -> Put
 putExtensions [] = return ()
 putExtensions es = putOpaque16 (runPut $ mapM_ putExtension es)
 
+------------------------------------------------------------
+
 getSignatureHashAlgorithm :: Get HashAndSignatureAlgorithm
 getSignatureHashAlgorithm = do
-    h <- fromJust . valToType <$> getWord8
-    s <- fromJust . valToType <$> getWord8
-    return (h,s)
+    h <- HashAlgorithm <$> getWord8
+    s <- SignatureAlgorithm <$> getWord8
+    return (h, s)
 
 putSignatureHashAlgorithm :: HashAndSignatureAlgorithm -> Put
-putSignatureHashAlgorithm (h,s) =
-    putWord8 (valOfType h) >> putWord8 (valOfType s)
+putSignatureHashAlgorithm (HashAlgorithm h, SignatureAlgorithm s) =
+    putWord8 h >> putWord8 s
 
+------------------------------------------------------------
+
 getServerDHParams :: Get ServerDHParams
-getServerDHParams = ServerDHParams <$> getDHParams <*> getDHPublic
-  where getDHParams = dhParams <$> getInteger16 -- p
-                               <*> getInteger16 -- g
-        getDHPublic = dhPublic <$> getInteger16 -- y(server)
+getServerDHParams = ServerDHParams <$> getBigNum16 <*> getBigNum16 <*> getBigNum16
 
 putServerDHParams :: ServerDHParams -> Put
-putServerDHParams (ServerDHParams dhparams dhpub) =
-    mapM_ putInteger16 $ dhUnwrap dhparams dhpub
-
-getDigitallySigned :: Version -> Get DigitallySigned
-getDigitallySigned ver
-    | ver >= TLS12 = DigitallySigned <$> (Just <$> getSignatureHashAlgorithm)
-                                     <*> getOpaque16
-    | otherwise    = DigitallySigned Nothing <$> getOpaque16
+putServerDHParams (ServerDHParams p g y) = mapM_ putBigNum16 [p, g, y]
 
-putDigitallySigned :: DigitallySigned -> Put
-putDigitallySigned (DigitallySigned mhash sig) =
-    maybe (return ()) putSignatureHashAlgorithm mhash >> putOpaque16 sig
+------------------------------------------------------------
 
-{-
- - decode and encode ALERT
- -}
+-- RFC 4492 Section 5.4 Server Key Exchange
+getServerECDHParams :: Get ServerECDHParams
+getServerECDHParams = do
+    curveType <- getWord8
+    case curveType of
+        3 -> do
+            -- ECParameters ECCurveType: curve name type
+            grp <- Group <$> getWord16 -- ECParameters NamedCurve
+            mxy <- getOpaque8 -- ECPoint
+            case groupDecodePublicA grp mxy of
+                Left e -> fail $ "getServerECDHParams: " ++ show e
+                Right grppub -> return $ ServerECDHParams grp grppub
+        _ -> fail "getServerECDHParams: unknown type for ECDH Params"
 
-decodeChangeCipherSpec :: ByteString -> Either TLSError ()
-decodeChangeCipherSpec = runGetErr "changecipherspec" $ do
-    x <- getWord8
-    when (x /= 1) (fail "unknown change cipher spec content")
+-- RFC 4492 Section 5.4 Server Key Exchange
+putServerECDHParams :: ServerECDHParams -> Put
+putServerECDHParams (ServerECDHParams (Group grp) grppub) = do
+    putWord8 3 -- ECParameters ECCurveType
+    putWord16 grp -- ECParameters NamedCurve
+    putOpaque8 $ groupEncodePublicA grppub -- ECPoint
 
-encodeChangeCipherSpec :: ByteString
-encodeChangeCipherSpec = runPut (putWord8 1)
+------------------------------------------------------------
 
--- rsa pre master secret
-decodePreMasterSecret :: Bytes -> Either TLSError (Version, Bytes)
-decodePreMasterSecret = runGetErr "pre-master-secret" $ do
-    liftM2 (,) getVersion (getBytes 46)
+getDigitallySigned :: Version -> Get DigitallySigned
+getDigitallySigned _ver =
+    DigitallySigned
+        <$> getSignatureHashAlgorithm
+        <*> getOpaque16
 
-encodePreMasterSecret :: Version -> Bytes -> Bytes
-encodePreMasterSecret version bytes = runPut (putVersion version >> putBytes bytes)
+putDigitallySigned :: DigitallySigned -> Put
+putDigitallySigned (DigitallySigned h sig) =
+    putSignatureHashAlgorithm h >> putOpaque16 sig
 
--- | in certain cases, we haven't manage to decode ServerKeyExchange properly,
--- because the decoding was too eager and the cipher wasn't been set yet.
--- we keep the Server Key Exchange in it unparsed format, and this function is
--- able to really decode the server key xchange if it's unparsed.
-decodeReallyServerKeyXchgAlgorithmData :: Version
-                                       -> CipherKeyExchangeType
-                                       -> Bytes
-                                       -> Either TLSError ServerKeyXchgAlgorithmData
-decodeReallyServerKeyXchgAlgorithmData ver cke =
-    runGetErr "server-key-xchg-algorithm-data" (decodeServerKeyXchgAlgorithmData ver cke)
+------------------------------------------------------------
 
+-- RSA pre-main secret
+decodePreMainSecret :: ByteString -> Either TLSError (Version, ByteString)
+decodePreMainSecret =
+    runGetErr "pre-main-secret" $
+        (,) <$> getBinaryVersion <*> getBytes 46
 
-{-
- - generate things for packet content
- -}
-type PRF = Bytes -> Bytes -> Int -> Bytes
+encodePreMainSecret :: Version -> ByteString -> ByteString
+encodePreMainSecret version bytes = runPut (putBinaryVersion version >> putBytes bytes)
 
-generateMasterSecret_SSL :: Bytes -> ClientRandom -> ServerRandom -> Bytes
-generateMasterSecret_SSL premasterSecret (ClientRandom c) (ServerRandom s) =
-    B.concat $ map (computeMD5) ["A","BB","CCC"]
-  where computeMD5  label = MD5.hash $ B.concat [ premasterSecret, computeSHA1 label ]
-        computeSHA1 label = SHA1.hash $ B.concat [ label, premasterSecret, c, s ]
+------------------------------------------------------------
+-- generate things for packet content
 
-generateMasterSecret_TLS :: PRF -> Bytes -> ClientRandom -> ServerRandom -> Bytes
-generateMasterSecret_TLS prf premasterSecret (ClientRandom c) (ServerRandom s) =
-    prf premasterSecret seed 48
-  where seed = B.concat [ "master secret", c, s ]
+-- | The TLS12 PRF is cipher specific, and some TLS12 algorithms use SHA384
+-- instead of the default SHA256.
+getPRF :: Version -> Cipher -> PRF
+getPRF ver ciph
+    | ver < TLS12 = prf_MD5SHA1
+    | maybe True (< TLS12) (cipherMinVer ciph) = prf_SHA256
+    | otherwise = prf_TLS ver $ fromMaybe SHA256 $ cipherPRFHash ciph
 
-generateMasterSecret :: Version -> Bytes -> ClientRandom -> ServerRandom -> Bytes
-generateMasterSecret SSL2  = generateMasterSecret_SSL
-generateMasterSecret SSL3  = generateMasterSecret_SSL
-generateMasterSecret TLS10 = generateMasterSecret_TLS prf_MD5SHA1
-generateMasterSecret TLS11 = generateMasterSecret_TLS prf_MD5SHA1
-generateMasterSecret TLS12 = generateMasterSecret_TLS prf_SHA256
+generateMainSecret_TLS
+    :: PRF
+    -> Secret
+    -> ClientRandom
+    -> ServerRandom
+    -> Secret
+generateMainSecret_TLS prf preMainSecret (ClientRandom c) (ServerRandom s) =
+    prf preMainSecret seed 48
+  where
+    seed = B.concat ["master secret", c, s]
 
-generateKeyBlock_TLS :: PRF -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
-generateKeyBlock_TLS prf (ClientRandom c) (ServerRandom s) mastersecret kbsize =
-    prf mastersecret seed kbsize where seed = B.concat [ "key expansion", s, c ]
+generateMainSecret
+    :: Version
+    -> Cipher
+    -> Secret
+    -> ClientRandom
+    -> ServerRandom
+    -> Secret
+generateMainSecret v c = generateMainSecret_TLS $ getPRF v c
 
-generateKeyBlock_SSL :: ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
-generateKeyBlock_SSL (ClientRandom c) (ServerRandom s) mastersecret kbsize =
-    B.concat $ map computeMD5 $ take ((kbsize `div` 16) + 1) labels
-  where labels            = [ uncurry BC.replicate x | x <- zip [1..] ['A'..'Z'] ]
-        computeMD5  label = MD5.hash $ B.concat [ mastersecret, computeSHA1 label ]
-        computeSHA1 label = SHA1.hash $ B.concat [ label, mastersecret, s, c ]
+generateExtendedMainSecret
+    :: ByteArrayAccess preMain
+    => Version
+    -> Cipher
+    -> preMain
+    -> ByteString
+    -> Secret
+generateExtendedMainSecret v c preMainSecret sessionHash =
+    getPRF v c (convert preMainSecret) seed 48
+  where
+    seed = B.append "extended master secret" sessionHash
 
-generateKeyBlock :: Version -> ClientRandom -> ServerRandom -> Bytes -> Int -> Bytes
-generateKeyBlock SSL2  = generateKeyBlock_SSL
-generateKeyBlock SSL3  = generateKeyBlock_SSL
-generateKeyBlock TLS10 = generateKeyBlock_TLS prf_MD5SHA1
-generateKeyBlock TLS11 = generateKeyBlock_TLS prf_MD5SHA1
-generateKeyBlock TLS12 = generateKeyBlock_TLS prf_SHA256
+generateKeyBlock_TLS
+    :: PRF -> ClientRandom -> ServerRandom -> Secret -> Int -> Secret
+generateKeyBlock_TLS prf (ClientRandom c) (ServerRandom s) mainSecret kbsize =
+    prf mainSecret seed kbsize
+  where
+    seed = B.concat ["key expansion", s, c]
 
-generateFinished_TLS :: PRF -> Bytes -> Bytes -> HashCtx -> Bytes
-generateFinished_TLS prf label mastersecret hashctx = prf mastersecret seed 12
-  where seed = B.concat [ label, hashFinal hashctx ]
+generateKeyBlock
+    :: Version
+    -> Cipher
+    -> ClientRandom
+    -> ServerRandom
+    -> Secret
+    -> Int
+    -> Secret
+generateKeyBlock v c = generateKeyBlock_TLS $ getPRF v c
 
-generateFinished_SSL :: Bytes -> Bytes -> HashCtx -> Bytes
-generateFinished_SSL sender mastersecret hashctx = B.concat [md5hash, sha1hash]
-  where md5hash  = MD5.hash $ B.concat [ mastersecret, pad2, md5left ]
-        sha1hash = SHA1.hash $ B.concat [ mastersecret, B.take 40 pad2, sha1left ]
+------------------------------------------------------------
 
-        lefthash = hashFinal $ flip hashUpdateSSL (pad1, B.take 40 pad1)
-                             $ foldl hashUpdate hashctx [sender,mastersecret]
-        (md5left,sha1left) = B.splitAt 16 lefthash
-        pad2     = B.replicate 48 0x5c
-        pad1     = B.replicate 48 0x36
+encodeSignedDHParams
+    :: ServerDHParams -> ClientRandom -> ServerRandom -> ByteString
+encodeSignedDHParams dhparams cran sran =
+    runPut $
+        putClientRandom32 cran >> putServerRandom32 sran >> putServerDHParams dhparams
 
-generateClientFinished :: Version -> Bytes -> HashCtx -> Bytes
-generateClientFinished ver
-    | ver < TLS10 = generateFinished_SSL "CLNT"
-    | ver < TLS12 = generateFinished_TLS prf_MD5SHA1 "client finished"
-    | otherwise   = generateFinished_TLS prf_SHA256 "client finished"
+-- Combination of RFC 5246 and 4492 is ambiguous.
+-- Let's assume ecdhe_rsa and ecdhe_dss are identical to
+-- dhe_rsa and dhe_dss.
+encodeSignedECDHParams
+    :: ServerECDHParams -> ClientRandom -> ServerRandom -> ByteString
+encodeSignedECDHParams dhparams cran sran =
+    runPut $
+        putClientRandom32 cran >> putServerRandom32 sran >> putServerECDHParams dhparams
 
-generateServerFinished :: Version -> Bytes -> HashCtx -> Bytes
-generateServerFinished ver
-    | ver < TLS10 = generateFinished_SSL "SRVR"
-    | ver < TLS12 = generateFinished_TLS prf_MD5SHA1 "server finished"
-    | otherwise   = generateFinished_TLS prf_SHA256 "server finished"
+encodeCertificate :: CertificateChain -> ByteString
+encodeCertificate cc = runPut $ putOpaque24 (runPut $ mapM_ putOpaque24 certs)
+  where
+    (CertificateChainRaw certs) = encodeCertificateChain cc
 
-generateCertificateVerify_SSL :: Bytes -> HashCtx -> Bytes
-generateCertificateVerify_SSL = generateFinished_SSL ""
+------------------------------------------------------------
 
-encodeSignedDHParams :: ClientRandom -> ServerRandom -> ServerDHParams -> Bytes
-encodeSignedDHParams cran sran dhparams = runPut $
-    putClientRandom32 cran >> putServerRandom32 sran >> putServerDHParams dhparams
+-- | in certain cases, we haven't manage to decode ServerKeyExchange properly,
+-- because the decoding was too eager and the cipher wasn't been set yet.
+-- we keep the Server Key Exchange in it unparsed format, and this function is
+-- able to really decode the server key xchange if it's unparsed.
+decodeReallyServerKeyXchgAlgorithmData
+    :: Version
+    -> CipherKeyExchangeType
+    -> ByteString
+    -> Either TLSError ServerKeyXchgAlgorithmData
+decodeReallyServerKeyXchgAlgorithmData ver cke =
+    runGetErr
+        "server-key-xchg-algorithm-data"
+        (decodeServerKeyXchgAlgorithmData ver cke)
diff --git a/Network/TLS/Packet13.hs b/Network/TLS/Packet13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Packet13.hs
@@ -0,0 +1,233 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.TLS.Packet13 (
+    encodeHandshake13,
+    decodeHandshakeRecord13,
+    decodeHandshake13,
+    decodeHandshakes13,
+    encodeCertificate13,
+) where
+
+import Codec.Compression.Zlib
+import qualified Control.Exception as E
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import Data.X509 (
+    CertificateChain,
+    CertificateChainRaw (..),
+    decodeCertificateChain,
+    encodeCertificateChain,
+ )
+import System.IO.Unsafe
+
+import Network.TLS.ErrT
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+import Network.TLS.Wire
+
+----------------------------------------------------------------
+
+encodeHandshake13 :: Handshake13 -> ByteString
+encodeHandshake13 hdsk = pkt
+  where
+    tp = typeOfHandshake13 hdsk
+    content = encodeHandshake13' hdsk
+    len = B.length content
+    header = encodeHandshakeHeader13 tp len
+    pkt = B.concat [header, content]
+
+-- TLS 1.3 does not use "select (extensions_present)".
+putExtensions :: [ExtensionRaw] -> Put
+putExtensions es = putOpaque16 (runPut $ mapM_ putExtension es)
+
+encodeHandshake13' :: Handshake13 -> ByteString
+encodeHandshake13' (ServerHello13 SH{..}) = runPut $ do
+    putBinaryVersion shVersion
+    putServerRandom32 shRandom
+    putSession shSession
+    putWord16 $ fromCipherId shCipher
+    putWord8 shComp
+    putExtensions shExtensions
+encodeHandshake13'
+    ( NewSessionTicket13
+            life
+            ageadd
+            (TicketNonce nonce)
+            (SessionIDorTicket_ label)
+            exts
+        ) = runPut $ do
+        putWord32 life
+        putWord32 ageadd
+        putOpaque8 nonce
+        putOpaque16 label
+        putExtensions exts
+encodeHandshake13' EndOfEarlyData13 = ""
+encodeHandshake13' (EncryptedExtensions13 exts) = runPut $ putExtensions exts
+encodeHandshake13' (Certificate13 reqctx (CertificateChain_ cc) ess) = encodeCertificate13 reqctx cc ess
+encodeHandshake13' (CertRequest13 reqctx exts) = runPut $ do
+    putOpaque8 reqctx
+    putExtensions exts
+encodeHandshake13' (CertVerify13 (DigitallySigned hs sig)) = runPut $ do
+    putSignatureHashAlgorithm hs
+    putOpaque16 sig
+encodeHandshake13' (Finished13 (VerifyData dat)) = runPut $ putBytes dat
+encodeHandshake13' (KeyUpdate13 UpdateNotRequested) = runPut $ putWord8 0
+encodeHandshake13' (KeyUpdate13 UpdateRequested) = runPut $ putWord8 1
+encodeHandshake13' (CompressedCertificate13 reqctx (CertificateChain_ cc) ess) = runPut $ do
+    putWord16 1 -- zlib: fixme
+    let bs = encodeCertificate13 reqctx cc ess
+    putWord24 $ fromIntegral $ B.length bs
+    putOpaque24 $ BL.toStrict $ compress $ BL.fromStrict bs
+
+encodeHandshakeHeader13 :: HandshakeType -> Int -> ByteString
+encodeHandshakeHeader13 ty len = runPut $ do
+    putWord8 (fromHandshakeType ty)
+    putWord24 len
+
+encodeCertificate13
+    :: CertReqContext -> CertificateChain -> [[ExtensionRaw]] -> ByteString
+encodeCertificate13 reqctx cc ess = runPut $ do
+    putOpaque8 reqctx
+    putOpaque24 (runPut $ mapM_ putCert $ zip certs ess)
+  where
+    CertificateChainRaw certs = encodeCertificateChain cc
+    putCert (certRaw, exts) = do
+        putOpaque24 certRaw
+        putExtensions exts
+
+----------------------------------------------------------------
+
+decodeHandshakes13 :: MonadError TLSError m => ByteString -> m [Handshake13]
+decodeHandshakes13 bs = case decodeHandshakeRecord13 bs of
+    GotError err -> throwError err
+    GotPartial _cont -> error "decodeHandshakes13"
+    GotSuccess (ty, content) -> case decodeHandshake13 ty content of
+        Left e -> throwError e
+        Right h -> return [h]
+    GotSuccessRemaining (ty, content) left -> case decodeHandshake13 ty content of
+        Left e -> throwError e
+        Right h -> (h :) <$> decodeHandshakes13 left
+
+decodeHandshakeRecord13 :: ByteString -> GetResult (HandshakeType, ByteString)
+decodeHandshakeRecord13 = runGet "handshake-record" $ do
+    ty <- getHandshakeType
+    content <- getOpaque24
+    return (ty, content)
+
+{- FOURMOLU_DISABLE -}
+decodeHandshake13
+    :: HandshakeType -> ByteString -> Either TLSError Handshake13
+decodeHandshake13 ty = runGetErr ("handshake[" ++ show ty ++ "]") $ case ty of
+    HandshakeType_ServerHello           -> decodeServerHello13
+    HandshakeType_NewSessionTicket      -> decodeNewSessionTicket13
+    HandshakeType_EndOfEarlyData        -> return EndOfEarlyData13
+    HandshakeType_EncryptedExtensions   -> decodeEncryptedExtensions13
+    HandshakeType_Certificate           -> decodeCertificate13
+    HandshakeType_CertRequest           -> decodeCertRequest13
+    HandshakeType_CertVerify            -> decodeCertVerify13
+    HandshakeType_Finished              -> decodeFinished13
+    HandshakeType_KeyUpdate             -> decodeKeyUpdate13
+    HandshakeType_CompressedCertificate -> decodeCompressedCertificate13
+    (HandshakeType x) -> fail $ "Unsupported HandshakeType " ++ show x
+{- FOURMOLU_ENABLE -}
+
+decodeServerHello13 :: Get Handshake13
+decodeServerHello13 = do
+    ver <- getBinaryVersion
+    random <- getServerRandom32
+    session <- getSession
+    cipherid <- CipherId <$> getWord16
+    comp <- getWord8
+    exts <- getWord16 >>= getExtensions . fromIntegral
+    return $
+        ServerHello13 $
+            SH
+                { shVersion = ver
+                , shRandom = random
+                , shSession = session
+                , shCipher = cipherid
+                , shComp = comp
+                , shExtensions = exts
+                }
+
+decodeNewSessionTicket13 :: Get Handshake13
+decodeNewSessionTicket13 = do
+    life <- getWord32
+    ageadd <- getWord32
+    nonce <- TicketNonce <$> getOpaque8
+    label <- SessionIDorTicket_ <$> getOpaque16
+    len <- fromIntegral <$> getWord16
+    exts <- getExtensions len
+    return $ NewSessionTicket13 life ageadd nonce label exts
+
+decodeEncryptedExtensions13 :: Get Handshake13
+decodeEncryptedExtensions13 =
+    EncryptedExtensions13 <$> do
+        len <- fromIntegral <$> getWord16
+        getExtensions len
+
+decodeCertificate13 :: Get Handshake13
+decodeCertificate13 = do
+    reqctx <- getOpaque8
+    len <- fromIntegral <$> getWord24
+    (certRaws, ess) <- unzip <$> getList len getCert
+    case decodeCertificateChain $ CertificateChainRaw certRaws of
+        Left (i, s) -> fail ("error certificate parsing " ++ show i ++ ":" ++ s)
+        Right cc -> return $ Certificate13 reqctx (CertificateChain_ cc) ess
+  where
+    getCert = do
+        l <- fromIntegral <$> getWord24
+        cert <- getBytes l
+        len <- fromIntegral <$> getWord16
+        exts <- getExtensions len
+        return (3 + l + 2 + len, (cert, exts))
+
+decodeCertRequest13 :: Get Handshake13
+decodeCertRequest13 = do
+    reqctx <- getOpaque8
+    len <- fromIntegral <$> getWord16
+    exts <- getExtensions len
+    return $ CertRequest13 reqctx exts
+
+decodeCertVerify13 :: Get Handshake13
+decodeCertVerify13 =
+    CertVerify13 <$> (DigitallySigned <$> getSignatureHashAlgorithm <*> getOpaque16)
+
+decodeFinished13 :: Get Handshake13
+decodeFinished13 = Finished13 . VerifyData <$> (remaining >>= getBytes)
+
+decodeKeyUpdate13 :: Get Handshake13
+decodeKeyUpdate13 = do
+    ru <- getWord8
+    case ru of
+        0 -> return $ KeyUpdate13 UpdateNotRequested
+        1 -> return $ KeyUpdate13 UpdateRequested
+        x -> fail $ "Unknown request_update: " ++ show x
+
+decodeCompressedCertificate13 :: Get Handshake13
+decodeCompressedCertificate13 = do
+    algo <- getWord16
+    when (algo /= 1) $ fail "comp algo is not supported" -- fixme
+    len <- getWord24
+    bs <- getOpaque24
+    if bs == ""
+        then fail "empty compressed certificate"
+        else case decompressIt bs of
+            Left e -> fail (show e)
+            Right bs' -> do
+                when (B.length bs' /= len) $ fail "plain length is wrong"
+                case runGetMaybe decodeCertificate13 bs' of
+                    Just (Certificate13 reqctx certs ess) -> return $ CompressedCertificate13 reqctx certs ess
+                    --                    _ -> fail "compressed certificate cannot be parsed"
+                    _ -> fail $ "invalid compressed certificate: len = " ++ show len
+
+decompressIt :: ByteString -> Either DecompressError ByteString
+decompressIt inp = unsafePerformIO $ E.handle handler $ do
+    Right . BL.toStrict <$> E.evaluate (decompress (BL.fromStrict inp))
+  where
+    handler e = return $ Left (e :: DecompressError)
diff --git a/Network/TLS/Parameters.hs b/Network/TLS/Parameters.hs
--- a/Network/TLS/Parameters.hs
+++ b/Network/TLS/Parameters.hs
@@ -1,243 +1,899 @@
--- |
--- Module      : Network.TLS.Parameters
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Parameters
-    (
-      ClientParams(..)
-    , ServerParams(..)
-    , CommonParams
-    , ClientHooks(..)
-    , ServerHooks(..)
-    , Supported(..)
-    , Shared(..)
-    -- * special default
-    , defaultParamsClient
-    -- * Parameters
-    , MaxFragmentEnum(..)
-    , CertificateUsage(..)
-    , CertificateRejectReason(..)
-    ) where
-
-import Network.BSD (HostName)
-
-import Network.TLS.Extension
-import Network.TLS.Struct
-import qualified Network.TLS.Struct as Struct
-import Network.TLS.Session
-import Network.TLS.Cipher
-import Network.TLS.Measurement
-import Network.TLS.Compression
-import Network.TLS.Crypto
-import Network.TLS.Credentials
-import Network.TLS.X509
-import Data.Monoid
-import Data.Default.Class
-import qualified Data.ByteString as B
-
-type CommonParams = (Supported, Shared)
-
-data ClientParams = ClientParams
-    { clientUseMaxFragmentLength    :: Maybe MaxFragmentEnum
-      -- | Define the name of the server, along with an extra service identification blob.
-      -- this is important that the hostname part is properly filled for security reason,
-      -- as it allow to properly associate the remote side with the given certificate
-      -- during a handshake.
-      --
-      -- The extra blob is useful to differentiate services running on the same host, but that
-      -- might have different certificates given. It's only used as part of the X509 validation
-      -- infrastructure.
-    , clientServerIdentification      :: (HostName, Bytes)
-      -- | Allow the use of the Server Name Indication TLS extension during handshake, which allow
-      -- the client to specify which host name, it's trying to access. This is useful to distinguish
-      -- CNAME aliasing (e.g. web virtual host).
-    , clientUseServerNameIndication   :: Bool
-      -- | try to establish a connection using this session.
-    , clientWantSessionResume         :: Maybe (SessionID, SessionData)
-    , clientShared                    :: Shared
-    , clientHooks                     :: ClientHooks
-    , clientSupported                 :: Supported
-    } deriving (Show)
-
-defaultParamsClient :: HostName -> Bytes -> ClientParams
-defaultParamsClient serverName serverId = ClientParams
-    { clientWantSessionResume    = Nothing
-    , clientUseMaxFragmentLength = Nothing
-    , clientServerIdentification = (serverName, serverId)
-    , clientUseServerNameIndication = True
-    , clientShared               = def
-    , clientHooks                = def
-    , clientSupported            = def
-    }
-
-data ServerParams = ServerParams
-    { -- | request a certificate from client.
-      serverWantClientCert    :: Bool
-
-      -- | This is a list of certificates from which the
-      -- disinguished names are sent in certificate request
-      -- messages.  For TLS1.0, it should not be empty.
-    , serverCACertificates :: [SignedCertificate]
-
-      -- | Server Optional Diffie Hellman parameters. If this value is not
-      -- properly set, no Diffie Hellman key exchange will take place.
-    , serverDHEParams         :: Maybe DHParams
-
-    , serverShared            :: Shared
-    , serverHooks             :: ServerHooks
-    , serverSupported         :: Supported
-    } deriving (Show)
-
-defaultParamsServer :: ServerParams
-defaultParamsServer = ServerParams
-    { serverWantClientCert   = False
-    , serverCACertificates   = []
-    , serverDHEParams        = Nothing
-    , serverHooks            = def
-    , serverShared           = def
-    , serverSupported        = def
-    }
-
-instance Default ServerParams where
-    def = defaultParamsServer
-
--- | List all the supported algorithms, versions, ciphers, etc supported.
-data Supported = Supported
-    {
-      -- | Supported Versions by this context
-      -- On the client side, the highest version will be used to establish the connection.
-      -- On the server side, the highest version that is less or equal than the client version will be chosed.
-      supportedVersions       :: [Version]
-      -- | Supported cipher methods
-    , supportedCiphers        :: [Cipher]
-      -- | supported compressions methods
-    , supportedCompressions   :: [Compression]
-      -- | All supported hash/signature algorithms pair for client
-      -- certificate verification, ordered by decreasing priority.
-    , supportedHashSignatures :: [HashAndSignatureAlgorithm]
-      -- | Set if we support secure renegotiation.
-    , supportedSecureRenegotiation :: Bool
-      -- | Set if we support session.
-    , supportedSession             :: Bool
-    } deriving (Show,Eq)
-
-defaultSupported :: Supported
-defaultSupported = Supported
-    { supportedVersions       = [TLS12,TLS11,TLS10,SSL3]
-    , supportedCiphers        = []
-    , supportedCompressions   = [nullCompression]
-    , supportedHashSignatures = [ (Struct.HashSHA512, SignatureRSA)
-                                , (Struct.HashSHA384, SignatureRSA)
-                                , (Struct.HashSHA256, SignatureRSA)
-                                , (Struct.HashSHA224, SignatureRSA)
-                                , (Struct.HashSHA1,   SignatureDSS)
-                                ]
-    , supportedSecureRenegotiation = True
-    , supportedSession             = True
-    }
-
-instance Default Supported where
-    def = defaultSupported
-
-data Shared = Shared
-    { sharedCredentials     :: Credentials
-    , sharedSessionManager  :: SessionManager
-    , sharedCAStore         :: CertificateStore
-    , sharedValidationCache :: ValidationCache
-    }
-
-instance Show Shared where
-    show _ = "Shared"
-instance Default Shared where
-    def = Shared
-            { sharedCAStore         = mempty
-            , sharedCredentials     = mempty
-            , sharedSessionManager  = noSessionManager
-            , sharedValidationCache = def
-            }
-
--- | A set of callbacks run by the clients for various corners of TLS establishment
-data ClientHooks = ClientHooks
-    { -- | This action is called when the server sends a
-      -- certificate request.  The parameter is the information
-      -- from the request.  The action should select a certificate
-      -- chain of one of the given certificate types where the
-      -- last certificate in the chain should be signed by one of
-      -- the given distinguished names.  Each certificate should
-      -- be signed by the following one, except for the last.  At
-      -- least the first of the certificates in the chain must
-      -- have a corresponding private key, because that is used
-      -- for signing the certificate verify message.
-      --
-      -- Note that is is the responsibility of this action to
-      -- select a certificate matching one of the requested
-      -- certificate types.  Returning a non-matching one will
-      -- lead to handshake failure later.
-      --
-      -- Returning a certificate chain not matching the
-      -- distinguished names may lead to problems or not,
-      -- depending whether the server accepts it.
-      onCertificateRequest :: ([CertificateType],
-                               Maybe [HashAndSignatureAlgorithm],
-                               [DistinguishedName]) -> IO (Maybe (CertificateChain, PrivKey))
-    , onNPNServerSuggest   :: Maybe ([B.ByteString] -> IO B.ByteString)
-    , onServerCertificate  :: CertificateStore -> ValidationCache -> ServiceID -> CertificateChain -> IO [FailedReason]
-    }
-
-defaultClientHooks :: ClientHooks
-defaultClientHooks = ClientHooks
-    { onCertificateRequest = \ _ -> return Nothing
-    , onNPNServerSuggest   = Nothing
-    , onServerCertificate  = validateDefault
-    }
-
-instance Show ClientHooks where
-    show _ = "ClientHooks"
-instance Default ClientHooks where
-    def = defaultClientHooks
-
--- | A set of callbacks run by the server for various corners of the TLS establishment
-data ServerHooks = ServerHooks
-    {
-      -- | This action is called when a client certificate chain
-      -- is received from the client.  When it returns a
-      -- CertificateUsageReject value, the handshake is aborted.
-      onClientCertificate :: CertificateChain -> IO CertificateUsage
-
-      -- | This action is called when the client certificate
-      -- cannot be verified.  A 'Nothing' argument indicates a
-      -- wrong signature, a 'Just e' message signals a crypto
-      -- error.
-    , onUnverifiedClientCert :: IO Bool
-
-      -- | Allow the server to choose the cipher relative to the
-      -- the client version and the client list of ciphers.
-      --
-      -- This could be useful with old clients and as a workaround
-      -- to the BEAST (where RC4 is sometimes prefered with TLS < 1.1)
-      --
-      -- The client cipher list cannot be empty.
-    , onCipherChoosing        :: Version -> [Cipher] -> Cipher
-
-      -- | suggested next protocols accoring to the next protocol negotiation extension.
-    , onSuggestNextProtocols  :: IO (Maybe [B.ByteString])
-      -- | at each new handshake, we call this hook to see if we allow handshake to happens.
-    , onNewHandshake          :: Measurement -> IO Bool
-    }
-
-defaultServerHooks :: ServerHooks
-defaultServerHooks = ServerHooks
-    { onCipherChoosing       = \_ -> head
-    , onClientCertificate    = \_ -> return $ CertificateUsageReject $ CertificateRejectOther "no client certificates expected"
-    , onUnverifiedClientCert = return False
-    , onSuggestNextProtocols = return Nothing
-    , onNewHandshake         = \_ -> return True
-    }
-
-instance Show ServerHooks where
-    show _ = "ClientHooks"
-instance Default ServerHooks where
-    def = defaultServerHooks
+{-# LANGUAGE Strict #-}
+
+module Network.TLS.Parameters (
+    ClientParams (..),
+    defaultParamsClient,
+    ServerParams (..),
+    defaultParamsServer,
+    CommonParams,
+    DebugParams (..),
+    defaultDebugParams,
+    defaultKeyLogger,
+    ClientHooks (..),
+    defaultClientHooks,
+    OnCertificateRequest,
+    OnServerCertificate,
+    ServerHooks (..),
+    defaultServerHooks,
+    Supported (..),
+    defaultSupported,
+    Shared (..),
+    defaultShared,
+    Limit (..),
+    defaultLimit,
+
+    -- * Parameters
+    MaxFragmentEnum (..),
+    EMSMode (..),
+    GroupUsage (..),
+    CertificateUsage (..),
+    CertificateRejectReason (..),
+    Information (..),
+) where
+
+import Control.Concurrent (MVar, newMVar, withMVar)
+import Crypto.HPKE
+import Data.Default (Default (def))
+import System.Environment (lookupEnv)
+import System.IO.Unsafe (unsafePerformIO)
+
+import Network.TLS.Cipher
+import Network.TLS.Compression
+import Network.TLS.Credentials
+import Network.TLS.Crypto
+import Network.TLS.ECH.Config
+import Network.TLS.Extension
+import Network.TLS.Extra.Cipher
+import Network.TLS.Handshake.State
+import Network.TLS.Imports
+import Network.TLS.Measurement
+import Network.TLS.RNG (Seed)
+import Network.TLS.Session
+import Network.TLS.Struct
+import qualified Network.TLS.Struct as Struct
+import Network.TLS.Types (HostName)
+import Network.TLS.X509
+
+type CommonParams = (Supported, Shared, DebugParams)
+
+-- | All settings should not be used in production
+data DebugParams = DebugParams
+    { debugSeed :: Maybe Seed
+    -- ^ Disable the true randomness in favor of deterministic seed that will produce
+    -- a deterministic random from. This is useful for tests and debugging purpose.
+    -- Do not use in production
+    --
+    -- Default: 'Nothing'
+    , debugPrintSeed :: Seed -> IO ()
+    -- ^ Add a way to print the seed that was randomly generated. reusing the same seed
+    -- will reproduce the same randomness with 'debugSeed'
+    --
+    -- Default: no printing
+    , debugVersionForced :: Maybe Version
+    -- ^ Force to choose this version in the server side.
+    --
+    -- Default: 'Nothing'
+    , debugKeyLogger :: String -> IO ()
+    -- ^ Printing main keys.
+    --
+    -- Default: no printing
+    , debugError :: String -> IO ()
+    , debugTraceKey :: String -> IO ()
+    }
+
+{-# NOINLINE keyLogLock #-}
+keyLogLock :: MVar ()
+keyLogLock = unsafePerformIO $ newMVar ()
+
+{-# NOINLINE keyLogFile #-}
+keyLogFile :: Maybe FilePath
+keyLogFile = unsafePerformIO $ lookupEnv "SSLKEYLOGFILE"
+
+-- | Key logger with the SSLKEYLOGFILE environment variable.
+defaultKeyLogger :: String -> IO ()
+defaultKeyLogger ~msg = case keyLogFile of
+    Nothing -> return ()
+    Just file -> withMVar keyLogLock $ \_ -> appendFile file (msg ++ "\n")
+
+-- | Default value for 'DebugParams'
+defaultDebugParams :: DebugParams
+defaultDebugParams =
+    DebugParams
+        { debugSeed = Nothing
+        , debugPrintSeed = const (return ())
+        , debugVersionForced = Nothing
+        , debugKeyLogger = defaultKeyLogger
+        , debugError = \ ~_ -> return ()
+        , debugTraceKey = \ ~_ -> return ()
+        }
+
+instance Show DebugParams where
+    show _ = "DebugParams"
+instance Default DebugParams where
+    def = defaultDebugParams
+
+{-# DEPRECATED clientUseMaxFragmentLength "UseMaxFragmentLength is deprecated" #-}
+
+data ClientParams = ClientParams
+    { clientUseMaxFragmentLength :: Maybe MaxFragmentEnum
+    -- ^
+    --
+    -- Default: 'Nothing'
+    , clientServerIdentification :: (HostName, ByteString)
+    -- ^ Define the name of the server, along with an extra service
+    -- identification blob.  this is important that the hostname part
+    -- is properly filled for security reason, as it allow to properly
+    -- associate the remote side with the given certificate during a
+    -- handshake.
+    --
+    -- The extra blob is useful to differentiate services running on
+    -- the same host, but that might have different certificates
+    -- given. It's only used as part of the X509 validation
+    -- infrastructure.
+    --
+    -- This value is typically set by 'defaultParamsClient'.
+    , clientUseServerNameIndication :: Bool
+    -- ^ Allow the use of the Server Name Indication TLS extension
+    -- during handshake, which allow the client to specify which host
+    -- name, it's trying to access. This is useful to distinguish
+    -- CNAME aliasing (e.g. web virtual host).
+    --
+    -- Default: 'True'
+    , clientWantSessionResume :: Maybe (SessionID, SessionData)
+    -- ^ try to establish a connection using this session for TLS
+    -- 1.2/TLS 1.3.  This can be used for TLS 1.3 but for backward
+    -- compatibility purpose only.  Use 'clientWantSessionResume13'
+    -- instead for TLS 1.3.
+    --
+    -- Default: 'Nothing'
+    , clientWantSessionResumeList :: [(SessionID, SessionData)]
+    -- ^ try to establish a connection using one of this sessions
+    -- especially for TLS 1.3.  This take precedence over
+    -- 'clientWantSessionResume'.  For convenience, this can be
+    -- specified for TLS 1.2 but only the first entry is used.
+    --
+    -- Default: '[]'
+    , clientWantTicket :: Bool
+    -- ^ Whether to solicit TLS 1.2 session tickets (or TLS 1.3
+    -- resumption PSKs) from servers.  With a 'False' setting,
+    -- stateless clients that never do resumption can avoid
+    -- wasting server and client resources used to generate,
+    -- transmit and process tickets that will never be used.
+    --
+    -- Default: 'True'
+    --
+    -- @since 2.4.1
+    , clientShared :: Shared
+    -- ^ See the default value of 'Shared'.
+    , clientHooks :: ClientHooks
+    -- ^ See the default value of 'ClientHooks'.
+    , clientSupported :: Supported
+    -- ^ In this element, you'll need to override the default empty
+    -- value of of 'supportedCiphers' with a suitable cipherlist.
+    --
+    -- See the default value of 'Supported'.
+    , clientDebug :: DebugParams
+    -- ^ See the default value of 'DebugParams'.
+    , clientUseEarlyData :: Bool
+    -- ^ Client tries to send early data in TLS 1.3 via 'sendData' if
+    -- possible.  If not accepted by the server, the early data is
+    -- automatically re-sent.
+    --
+    -- Default: 'False'
+    , clientUseECH :: Bool
+    -- ^ Enabling Encrypted Client Hello.
+    -- If 'sharedECHConfigList' is null, a greasing ECH extension is sent.
+    -- Otherwise, a valid ECH is sent.
+    -- If the server rejects ECH in Server Hello,
+    -- the client sends an alert after negotiation.
+    --
+    -- Default: 'False'
+    --
+    -- @since 2.1.9
+    }
+    deriving (Show)
+
+-- | Default value for 'ClientParams'
+defaultParamsClient :: HostName -> ByteString -> ClientParams
+defaultParamsClient serverName serverId =
+    ClientParams
+        { clientUseMaxFragmentLength = Nothing
+        , clientServerIdentification = (serverName, serverId)
+        , clientUseServerNameIndication = True
+        , clientWantSessionResume = Nothing
+        , clientWantSessionResumeList = []
+        , clientWantTicket = True
+        , clientShared = def
+        , clientHooks = def
+        , clientSupported = def
+        , clientDebug = defaultDebugParams
+        , clientUseEarlyData = False
+        , clientUseECH = False
+        }
+
+data ServerParams = ServerParams
+    { serverWantClientCert :: Bool
+    -- ^ Request a certificate from client.
+    --
+    -- Default: 'False'
+    , serverCACertificates :: [SignedCertificate]
+    -- ^ This is a list of certificates from which the disinguished
+    -- names are sent in certificate request messages.  For TLS1.0, it
+    -- should not be empty.
+    --
+    -- Default: '[]'
+    , serverDHEParams :: Maybe DHParams
+    -- ^ Server Optional Diffie Hellman parameters.  Setting
+    -- parameters is necessary for FFDHE key exchange when clients are
+    -- not compatible with RFC 7919.
+    --
+    -- Value can be one of the standardized groups from module
+    -- "Network.TLS.Extra.FFDHE" or custom parameters generated with
+    -- 'Crypto.PubKey.DH.generateParams'.
+    --
+    -- Default: 'Nothing'
+    , serverHooks :: ServerHooks
+    -- ^ See the default value of 'ServerHooks'.
+    , serverShared :: Shared
+    -- ^ See the default value of 'Shared'.
+    , serverSupported :: Supported
+    -- ^ See the default value of 'Supported'.
+    , serverDebug :: DebugParams
+    -- ^ See the default value of 'DebugParams'.
+    , serverEarlyDataSize :: Int
+    -- ^ Server accepts this size of early data in TLS 1.3.  0 (or
+    -- lower) means that the server does not accept early data.
+    --
+    -- Default: 0
+    , serverTicketLifetime :: Int
+    -- ^ Lifetime in seconds for session tickets generated by the
+    -- server.  Acceptable value range is 0 to 604800 (7 days).
+    --
+    -- Default: 7200 (2 hours)
+    , serverECHKey :: [(ConfigId, ByteString)]
+    -- ^ ECH secret keys.
+    --
+    -- Default: '[]'
+    --
+    -- @since 2.1.9
+    }
+    deriving (Show)
+
+defaultParamsServer :: ServerParams
+defaultParamsServer =
+    ServerParams
+        { serverWantClientCert = False
+        , serverCACertificates = []
+        , serverDHEParams = Nothing
+        , serverHooks = def
+        , serverShared = def
+        , serverSupported = def
+        , serverDebug = defaultDebugParams
+        , serverEarlyDataSize = 0
+        , serverTicketLifetime = 7200
+        , serverECHKey = []
+        }
+
+instance Default ServerParams where
+    def = defaultParamsServer
+
+-- | List all the supported algorithms, versions, ciphers, etc supported.
+data Supported = Supported
+    { supportedVersions :: [Version]
+    -- ^ Supported versions by this context.  On the client side, the
+    -- highest version will be used to establish the connection.  On
+    -- the server side, the highest version that is less or equal than
+    -- the client version will be chosen.
+    --
+    -- Versions should be listed in preferred order, i.e. higher
+    -- versions first.
+    --
+    -- Default: @[TLS13,TLS12]@
+    , supportedCiphers :: [Cipher]
+    -- ^ Supported cipher methods.  The default is empty, specify a
+    -- suitable cipher list.
+    -- 'Network.TLS.Extra.Cipher.ciphersuite_default' is often a good
+    -- choice.
+    --
+    -- Default: @[]@
+    , supportedCompressions :: [Compression]
+    -- ^ Supported compressions methods.  By default only the "null"
+    -- compression is supported, which means no compression will be
+    -- performed.  Allowing other compression method is not advised as
+    -- it causes a connection failure when TLS 1.3 is negotiated.
+    --
+    -- Default: @[nullCompression]@
+    , supportedHashSignatures :: [HashAndSignatureAlgorithm]
+    -- ^ All supported hash/signature algorithms pair for client
+    -- certificate verification and server signature in (EC)DHE,
+    -- ordered by decreasing priority.
+    --
+    -- This list is sent to the peer as part of the
+    -- "signature_algorithms" extension.  It is used to restrict
+    -- accepted signatures received from the peer at TLS level (not in
+    -- X.509 certificates), but only when the TLS version is 1.2 or
+    -- above.  In order to disable SHA-1 one must then also disable
+    -- earlier protocol versions in 'supportedVersions'.
+    --
+    -- The list also impacts the selection of possible algorithms when
+    -- generating signatures.
+    --
+    -- Note: with TLS 1.3 some algorithms have been deprecated and
+    -- will not be used even when listed in the parameter: MD5, SHA-1,
+    -- SHA-224, RSA PKCS#1, DSA.
+    --
+    -- Default:
+    --
+    -- @
+    --   [ (HashIntrinsic,     SignatureEd448)
+    --   , (HashIntrinsic,     SignatureEd25519)
+    --   , (Struct.HashSHA256, SignatureECDSA)
+    --   , (Struct.HashSHA384, SignatureECDSA)
+    --   , (Struct.HashSHA512, SignatureECDSA)
+    --   , (HashIntrinsic,     SignatureRSApssRSAeSHA512)
+    --   , (HashIntrinsic,     SignatureRSApssRSAeSHA384)
+    --   , (HashIntrinsic,     SignatureRSApssRSAeSHA256)
+    --   , (Struct.HashSHA512, SignatureRSA)
+    --   , (Struct.HashSHA384, SignatureRSA)
+    --   , (Struct.HashSHA256, SignatureRSA)
+    --   , (Struct.HashSHA1,   SignatureRSA)
+    --   , (Struct.HashSHA1,   SignatureDSA)
+    --   ]
+    -- @
+    , supportedSecureRenegotiation :: Bool
+    -- ^ Secure renegotiation defined in RFC5746.  If 'True', clients
+    --   send the renegotiation_info extension.  If 'True', servers
+    --   handle the extension or the renegotiation SCSV then send the
+    --   renegotiation_info extension.
+    --
+    --   Default: 'True'
+    , supportedClientInitiatedRenegotiation :: Bool
+    -- ^ If 'True', renegotiation is allowed from the client side.
+    --   This is vulnerable to DOS attacks.  If 'False', renegotiation
+    --   is allowed only from the server side via HelloRequest.
+    --
+    --   Default: 'False'
+    , supportedExtendedMainSecret :: EMSMode
+    -- ^ The mode regarding extended main secret.  Enabling this
+    -- extension provides better security for TLS versions 1.2.  TLS
+    -- 1.3 provides the security properties natively and does not need
+    -- the extension.
+    --
+    -- By default the extension is 'RequireEMS'.  So, the handshake
+    -- will fail when the peer does not support the extension.
+    --
+    -- Default: 'RequireEMS'
+    , supportedSession :: Bool
+    -- ^ Set if we support session.
+    --
+    --   Default: 'True'
+    , supportedFallbackScsv :: Bool
+    -- ^ Support for fallback SCSV defined in RFC7507.  If 'True',
+    --   servers reject handshakes which suggest a lower protocol than
+    --   the highest protocol supported.
+    --
+    --   Default: 'True'
+    , supportedEmptyPacket :: Bool
+    -- ^ In ver <= TLS1.0, block ciphers using CBC are using CBC
+    -- residue as IV, which can be guessed by an attacker. Hence, an
+    -- empty packet is normally sent before a normal data packet, to
+    -- prevent guessability. Some Microsoft TLS-based protocol
+    -- implementations, however, consider these empty packets as a
+    -- protocol violation and disconnect. If this parameter is
+    -- 'False', empty packets will never be added, which is less
+    -- secure, but might help in rare cases.
+    --
+    --   Default: 'True'
+    , supportedHPKE :: [(KEM_ID, KDF_ID, AEAD_ID)]
+    -- ^ Client only.
+    --
+    -- @since 2.1.9
+    , supportedGroups :: [Group]
+    -- ^ A list of supported elliptic curves and finite-field groups
+    --   in preferred order.
+    --
+    --   * TLS 1.3 client: this list is used as the 1st argument to
+    --     'onSelectKeyShareGroups' to select groups in "key_share".
+    --     This list is also used as values of "supported_groups".
+    --   * TLS 1.3 server: this list is not used.
+    --   * TLS 1.2 client: this list is also used as values of
+    --     "supported_groups".
+    --   * TLS 1.2 server: this list is used to select a key exchange
+    --     mechanism.
+    --
+    --   The list is sent to the server as part of the
+    --   "supported_groups" extension.  It is used in both clients and
+    --   servers to restrict accepted groups in DH key exchange.  Up
+    --   until TLS v1.2, it is also used by a client to restrict
+    --   accepted elliptic curves in ECDSA signatures.
+    --
+    --   The default value includes all groups with security strength
+    --   of 128 bits or more.
+    --
+    --   Default: @[X25519,P256,P384,X448,P521,FFDHE3072,FFDHE4096,FFDHE6144,FFDHE8192,X25519MLKEM768,P256MLKEM768,P384MLKEM1024,MLKEM768,MLKEM1024]@
+    , supportedGroupsTLS13 :: [[Group]]
+    -- ^ The inside @[Group]@ is the list of @Group@ at the same level
+    -- in preferred order.  The inside @[Group]@s are also listed in
+    -- preferred order.
+    --
+    -- TLS 1.3 server: this is used as the 1st argument to
+    -- 'onSelectKeyShare'.
+    --
+    -- Default: @[[X25519MLKEM768,P256MLKEM768,P384MLKEM1024],[X25519,P256],[P384,X448,P521],[FFDHE2048,FFDHE3072,FFDHE4096,FFDHE6144,FFDHE8192],[MLKEM768,MLKEM1024]]@
+    --
+    -- @since 2.2.3
+    }
+    deriving (Show, Eq)
+
+-- | Client or server policy regarding Extended Main Secret
+data EMSMode
+    = -- | Extended Main Secret is not used
+      NoEMS
+    | -- | Extended Main Secret is allowed
+      AllowEMS
+    | -- | Extended Main Secret is required
+      RequireEMS
+    deriving (Show, Eq)
+
+defaultHPKE :: [(KEM_ID, KDF_ID, AEAD_ID)]
+defaultHPKE =
+    [ (DHKEM_X25519_HKDF_SHA256, HKDF_SHA256, AES_128_GCM)
+    , (DHKEM_X25519_HKDF_SHA256, HKDF_SHA256, ChaCha20Poly1305)
+    , (DHKEM_P256_HKDF_SHA256, HKDF_SHA256, AES_128_GCM)
+    , (DHKEM_P256_HKDF_SHA256, HKDF_SHA512, AES_128_GCM)
+    , (DHKEM_P256_HKDF_SHA256, HKDF_SHA256, ChaCha20Poly1305)
+    , (DHKEM_P521_HKDF_SHA512, HKDF_SHA512, AES_256_GCM)
+    ]
+
+defaultSupported :: Supported
+defaultSupported =
+    Supported
+        { supportedVersions = [TLS13, TLS12]
+        , supportedCiphers = ciphersuite_default
+        , supportedCompressions = [nullCompression]
+        , supportedHashSignatures = Struct.supportedSignatureSchemes
+        , supportedSecureRenegotiation = True
+        , supportedClientInitiatedRenegotiation = False
+        , supportedExtendedMainSecret = RequireEMS
+        , supportedSession = True
+        , supportedFallbackScsv = True
+        , supportedEmptyPacket = True
+        , supportedHPKE = defaultHPKE
+        , supportedGroups = supportedNamedGroups
+        , supportedGroupsTLS13 = supportedNamedGroupsTLS13
+        }
+
+instance Default Supported where
+    def = defaultSupported
+
+-- | Parameters that are common to clients and servers.
+data Shared = Shared
+    { sharedCredentials :: Credentials
+    -- ^ The list of certificates and private keys that a server will
+    -- use as part of authentication to clients.  Actual credentials
+    -- that are used are selected dynamically from this list based on
+    -- client capabilities.  Additional credentials returned by
+    -- 'onServerNameIndication' are also considered.
+    --
+    -- When credential list is left empty (the default value), no key
+    -- exchange can take place.
+    --
+    -- Default: 'mempty'
+    , sharedSessionManager :: SessionManager
+    -- ^ Callbacks used by clients and servers in order to resume TLS
+    -- sessions.  The default implementation never resumes sessions.
+    -- Package
+    -- <https://hackage.haskell.org/package/tls-session-manager
+    -- tls-session-manager> provides an in-memory implementation.
+    --
+    -- Default: 'noSessionManager'
+    , sharedCAStore :: CertificateStore
+    -- ^ A collection of trust anchors to be used by a client as part
+    -- of validation of server certificates.  This is set as first
+    -- argument to function 'onServerCertificate'.  Package
+    -- <https://hackage.haskell.org/package/crypton-x509-system
+    -- crypton-x509-system> gives access to a default certificate
+    -- store configured in the system.
+    --
+    -- Default: 'mempty'
+    , sharedValidationCache :: ValidationCache
+    -- ^ Callbacks that may be used by a client to cache certificate
+    -- validation results (positive or negative) and avoid expensive
+    -- signature check.  The default implementation does not have any
+    -- caching.
+    --
+    -- See the default value of 'ValidationCache'.
+    , sharedHelloExtensions :: [ExtensionRaw]
+    -- ^ Additional extensions to be sent during the Hello sequence.
+    --
+    -- For a client this is always included in message ClientHello.
+    -- For a server, this is sent in messages ServerHello or
+    -- EncryptedExtensions based on the TLS version.
+    --
+    -- Default: @[]@
+    , sharedECHConfigList :: ECHConfigList
+    -- ^ ECH configuration.
+    --
+    -- @since 2.1.9
+    , sharedLimit :: Limit
+    -- ^ Limitation parameters.
+    --
+    -- @since 2.1.8
+    }
+
+instance Show Shared where
+    show _ = "Shared"
+instance Default Shared where
+    def = defaultShared
+
+defaultShared :: Shared
+defaultShared =
+    Shared
+        { sharedCredentials = mempty
+        , sharedSessionManager = noSessionManager
+        , sharedCAStore = mempty
+        , sharedValidationCache = def
+        , sharedHelloExtensions = []
+        , sharedECHConfigList = []
+        , sharedLimit = defaultLimit
+        }
+
+-- | Group usage callback possible return values.
+data GroupUsage
+    = -- | usage of group accepted
+      GroupUsageValid
+    | -- | usage of group provides insufficient security
+      GroupUsageInsecure
+    | -- | usage of group rejected for other reason (specified as string)
+      GroupUsageUnsupported String
+    | -- | usage of group with an invalid public value
+      GroupUsageInvalidPublic
+    deriving (Show, Eq)
+
+defaultGroupUsage :: Int -> DHParams -> DHPublic -> IO GroupUsage
+defaultGroupUsage minBits params public
+    | even $ dhParamsGetP params =
+        return $ GroupUsageUnsupported "invalid odd prime"
+    | not $ dhValid params (dhParamsGetG params) =
+        return $ GroupUsageUnsupported "invalid generator"
+    | not $ dhValid params (dhUnwrapPublic public) =
+        return GroupUsageInvalidPublic
+    -- To prevent Logjam attack
+    | dhParamsGetBits params < minBits = return GroupUsageInsecure
+    | otherwise = return GroupUsageValid
+
+-- | Type for 'onCertificateRequest'. This type synonym is to make
+--   document readable.
+type OnCertificateRequest =
+    ( [CertificateType]
+    , Maybe [HashAndSignatureAlgorithm]
+    , [DistinguishedName]
+    )
+    -> IO (Maybe (CertificateChain, PrivKey))
+
+-- | Type for 'onServerCertificate'. This type synonym is to make
+--   document readable.
+type OnServerCertificate =
+    CertificateStore
+    -> ValidationCache
+    -> ServiceID
+    -> CertificateChain
+    -> IO [FailedReason]
+
+-- | A set of callbacks run by the clients for various corners of TLS establishment
+data ClientHooks = ClientHooks
+    { onCertificateRequest :: OnCertificateRequest
+    -- ^ This action is called when the a certificate request is
+    -- received from the server. The callback argument is the
+    -- information from the request.  The server, at its discretion,
+    -- may be willing to continue the handshake without a client
+    -- certificate.  Therefore, the callback is free to return
+    -- 'Nothing' to indicate that no client certificate should be
+    -- sent, despite the server's request.  In some cases it may be
+    -- appropriate to get user consent before sending the certificate;
+    -- the content of the user's certificate may be sensitive and
+    -- intended only for specific servers.
+    --
+    -- The action should select a certificate chain of one of the
+    -- given certificate types and one of the certificates in the
+    -- chain should (if possible) be signed by one of the given
+    -- distinguished names.  Some servers, that don't have a narrow
+    -- set of preferred issuer CAs, will send an empty
+    -- 'DistinguishedName' list, rather than send all the names from
+    -- their trusted CA bundle.  If the client does not have a
+    -- certificate chaining to a matching CA, it may choose a default
+    -- certificate instead.
+    --
+    -- Each certificate except the last should be signed by the
+    -- following one.  The returned private key must be for the first
+    -- certificates in the chain.  This key will be used to signing
+    -- the certificate verify message.
+    --
+    -- The public key in the first certificate, and the matching
+    -- returned private key must be compatible with one of the list of
+    -- 'HashAndSignatureAlgorithm' value when provided.  TLS 1.3
+    -- changes the meaning of the list elements, adding explicit code
+    -- points for each supported pair of hash and signature (public
+    -- key) algorithms, rather than combining separate codes for the
+    -- hash and key.  For details see
+    -- <https://tools.ietf.org/html/rfc8446#section-4.2.3 RFC 8446>
+    -- section 4.2.3.  When no compatible certificate chain is
+    -- available, return 'Nothing' if it is OK to continue without a
+    -- client certificate.  Returning a non-matching certificate
+    -- should result in a handshake failure.
+    --
+    -- While the TLS version is not provided to the callback, the
+    -- content of the @signature_algorithms@ list provides a strong
+    -- hint, since TLS 1.3 servers will generally list RSA pairs with
+    -- a hash component of 'Intrinsic' (@0x08@).
+    --
+    -- Note that is is the responsibility of this action to select a
+    -- certificate matching one of the requested certificate types
+    -- (public key algorithms).  Returning a non-matching one will
+    -- lead to handshake failure later.
+    --
+    -- Default: returns 'Nothing' anyway.
+    , onServerCertificate :: OnServerCertificate
+    -- ^ Used by the client to validate the server certificate.  The
+    -- default implementation calls 'validateDefault' which validates
+    -- according to the default hooks and checks provided by
+    -- "Data.X509.Validation".  This can be replaced with a custom
+    -- validation function using different settings.
+    --
+    -- The function is not expected to verify the key-usage extension
+    -- of the end-entity certificate, as this depends on the
+    -- dynamically-selected cipher and this part should not be cached.
+    -- Key-usage verification is performed by the library internally.
+    --
+    -- Default: 'validateDefault'
+    , onSuggestALPN :: IO (Maybe [ByteString])
+    -- ^ This action is called when the client sends ClientHello
+    --   to determine ALPN values such as '["h2", "http/1.1"]'.
+    --
+    -- Default: returns 'Nothing'
+    , onCustomFFDHEGroup :: DHParams -> DHPublic -> IO GroupUsage
+    -- ^ This action is called to validate DHE parameters when the
+    --   server selected a finite-field group not part of the
+    --   "Supported Groups Registry" or not part of 'supportedGroups'
+    --   list.
+    --
+    --   With TLS 1.3 custom groups have been removed from the
+    --   protocol, so this callback is only used when the version
+    --   negotiated is 1.2 or below.
+    --
+    --   The default behavior with (dh_p, dh_g, dh_size) and pub as
+    --   follows:
+    --
+    --   (1) rejecting if dh_p is even
+    --   (2) rejecting unless 1 < dh_g && dh_g < dh_p - 1
+    --   (3) rejecting unless 1 < dh_p && pub < dh_p - 1
+    --   (4) rejecting if dh_size < 1024 (to prevent Logjam attack)
+    --
+    --   See RFC 7919 section 3.1 for recommendations.
+    , onServerFinished :: Information -> IO ()
+    -- ^ When a handshake is done, this hook can check `Information`.
+    , onSelectKeyShareGroups :: [Group] -> [Group]
+    -- ^ A function to select groups in "key_share" by TLS 1.3 client.
+    --
+    --   Client's 'supportedGroups' is passed as the 1st argument.
+    --
+    --   The default function specifies a pair of hybrid (classical +
+    --   post quantum) group and classical group to transit from
+    --   classical key exchange to hybrid key exchange. With the
+    --   default value of 'supportedGroups', X25519MLKEM and X25519
+    --   are chosen.
+    --
+    --   Middleboxes may drop a ClientHello that contains large
+    --   X2219MLKEM. In such environment, @take 1@, which selects
+    --   X22519 only with the default value, is maybe a good
+    --   candidate.
+    --
+    --   In the case where X22519 is only contained in "key_share", a
+    --   wise-server without nasty middleboxes may ask the client to
+    --   send X2219MLKEM via HelloRetryRequest as X2219MLKEM is
+    --   specified in "supported_groups".
+    --
+    --   @since 2.2.3
+    }
+
+defaultOnSelectKeyShareGroups :: [Group] -> [Group]
+defaultOnSelectKeyShareGroups groups = take 1 hs ++ take 1 es
+  where
+    (hs, es) = partition isHybrid groups
+
+isHybrid :: Group -> Bool
+isHybrid X25519MLKEM768 = True
+isHybrid P256MLKEM768 = True
+isHybrid P384MLKEM1024 = True
+isHybrid _ = False
+
+defaultClientHooks :: ClientHooks
+defaultClientHooks =
+    ClientHooks
+        { onCertificateRequest = \_ -> return Nothing
+        , onServerCertificate = validateDefault
+        , onSuggestALPN = return Nothing
+        , onCustomFFDHEGroup = defaultGroupUsage 1024
+        , onServerFinished = \_ -> return ()
+        , onSelectKeyShareGroups = defaultOnSelectKeyShareGroups
+        }
+
+instance Show ClientHooks where
+    show _ = "ClientHooks"
+instance Default ClientHooks where
+    def = defaultClientHooks
+
+-- | A set of callbacks run by the server for various corners of the TLS establishment
+data ServerHooks = ServerHooks
+    { onClientCertificate :: CertificateChain -> IO CertificateUsage
+    -- ^ This action is called when a client certificate chain is
+    -- received from the client.  When it returns a
+    -- CertificateUsageReject value, the handshake is aborted.
+    --
+    -- The function is not expected to verify the key-usage extension
+    -- of the certificate.  This verification is performed by the
+    -- library internally.
+    --
+    -- Default: returns the following:
+    --
+    -- @
+    -- CertificateUsageReject (CertificateRejectOther "no client certificates expected")
+    -- @
+    , onUnverifiedClientCert :: IO Bool
+    -- ^ This action is called when the client certificate cannot be
+    -- verified. Return 'True' to accept the certificate anyway, or
+    -- 'False' to fail verification.
+    --
+    -- Default: returns 'False'
+    , onCipherChoosing :: Version -> [Cipher] -> Cipher
+    -- ^ Allow the server to choose the cipher relative to the the
+    -- client version and the client list of ciphers.
+    --
+    -- This could be useful with old clients and as a workaround to
+    -- the BEAST (where RC4 is sometimes preferred with TLS < 1.1)
+    --
+    -- The client cipher list cannot be empty.
+    --
+    -- Default: taking the head of ciphers.
+    , onServerNameIndication :: Maybe HostName -> IO Credentials
+    -- ^ Allow the server to indicate additional credentials to be
+    -- used depending on the host name indicated by the client.
+    --
+    -- This is most useful for transparent proxies where credentials
+    -- must be generated on the fly according to the host the client
+    -- is trying to connect to.
+    --
+    -- Returned credentials may be ignored if a client does not
+    -- support the signature algorithms used in the certificate chain.
+    --
+    -- Default: returns 'mempty'
+    , onNewHandshake :: Measurement -> IO Bool
+    -- ^ At each new handshake, we call this hook to see if we allow
+    -- handshake to happens.
+    --
+    -- Default: returns 'True'
+    , onALPNClientSuggest :: Maybe ([ByteString] -> IO ByteString)
+    -- ^ Allow the server to choose an application layer protocol
+    --   suggested from the client through the ALPN (Application Layer
+    --   Protocol Negotiation) extensions.  If the server supports no
+    --   protocols that the client advertises an empty 'ByteString'
+    --   should be returned.
+    --
+    -- Default: 'Nothing'
+    , onEncryptedExtensionsCreating :: [ExtensionRaw] -> IO [ExtensionRaw]
+    -- ^ Allow to modify extensions to be sent in EncryptedExtensions
+    --  of TLS 1.3.
+    --
+    -- Default: 'return'
+    , onSelectKeyShare
+        :: [[Group]]
+        -> [Group]
+        -> [Group]
+        -> IO (Maybe Group, Bool)
+    -- ^ A function to select one key share by TLS 1.3 server.
+    --
+    -- The 1st argument is server's 'supportedGroupsTLS13'.
+    -- The 2nd arguments is client's groups in "supported_groups"
+    -- The 3rd arguments is client's groups in "key_share".
+    --
+    -- 'True' in the result indicates sending a hello retry request
+    -- with this group.
+    --
+    -- The default function targets @[Group]@ in the first argument in
+    -- order.  If there is a common group among the "key_share"
+    -- groups, it will use that group for key exchange.
+    -- Alternatively, if there is a common group among the
+    -- "supported_groups" groups, it will instruct to send the
+    -- HelloRetryRequest using that group.  Otherwise, it will check
+    -- the next @[Group]@.
+    --
+    -- @since 2.2.3
+    }
+
+-- | Default value for 'ServerHooks'
+defaultServerHooks :: ServerHooks
+defaultServerHooks =
+    ServerHooks
+        { onClientCertificate = \_ ->
+            return $
+                CertificateUsageReject $
+                    CertificateRejectOther "no client certificates expected"
+        , onUnverifiedClientCert = return False
+        , onCipherChoosing = \_ ccs -> case ccs of
+            [] -> error "onCipherChoosing"
+            c : _ -> c
+        , onServerNameIndication = \_ -> return mempty
+        , onNewHandshake = \_ -> return True
+        , onALPNClientSuggest = Nothing
+        , onEncryptedExtensionsCreating = return
+        , onSelectKeyShare = defaultOnSelectKeyShare
+        }
+
+instance Show ServerHooks where
+    show _ = "ServerHooks"
+instance Default ServerHooks where
+    def = defaultServerHooks
+
+defaultOnSelectKeyShare
+    :: [[Group]] -- Server groups
+    -> [Group] -- Client's groups in "supported_groups"
+    -> [Group] -- Client's groups in "key_share"
+    -> IO (Maybe Group, Bool)
+defaultOnSelectKeyShare serverSupportedLoL clientSupportedGroups clientKeyShareGroups = go serverSupportedLoL
+  where
+    go [] = return (Nothing, False)
+    go (gs : gss) = case gs `intersect` clientKeyShareGroups of
+        [] -> case gs `intersect` clientSupportedGroups of
+            [] -> go gss
+            h : _ -> return (Just h, True)
+        g : _ -> return (Just g, False)
+
+-- | Information related to a running context, e.g. current cipher
+data Information = Information
+    { infoVersion :: Version
+    , infoCipher :: Cipher
+    , infoCompression :: Compression
+    , infoMainSecret :: Maybe ByteString
+    , infoExtendedMainSecret :: Bool
+    , infoClientRandom :: Maybe ClientRandom
+    , infoServerRandom :: Maybe ServerRandom
+    , infoSupportedGroup :: Maybe Group
+    , infoTLS12Resumption :: Bool
+    , infoTLS13HandshakeMode :: Maybe HandshakeMode13
+    , infoIsEarlyDataAccepted :: Bool
+    , infoIsECHAccepted :: Bool
+    }
+    deriving (Show, Eq)
+
+-- | Limitations for security.
+--
+-- @since 2.1.7
+data Limit = Limit
+    { limitRecordSize :: Maybe Int
+    -- ^ Record size limit defined in RFC 8449.
+    --
+    -- If 'Nothing', the "record_size_limit" extension is not used.
+    --
+    -- In the case of 'Just': A client sends the "record_size_limit"
+    -- extension with this value to the server. A server sends back
+    -- this extension with its own value if a client sends the
+    -- extension. When negotiated, both my limit and peer's limit are
+    -- enabled for protected communication.
+    --
+    -- Default: Nothing
+    , limitHandshakeFragment :: Int
+    -- ^ The limit to accept the number of each handshake message.
+    -- For instance, a nasty client may send many fragments of client
+    -- certificate.
+    --
+    -- Default: 32
+    }
+    deriving (Eq, Show)
+
+-- | Default value for 'Limit'.
+defaultLimit :: Limit
+defaultLimit =
+    Limit
+        { limitRecordSize = Nothing
+        , limitHandshakeFragment = 32
+        }
diff --git a/Network/TLS/PostHandshake.hs b/Network/TLS/PostHandshake.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/PostHandshake.hs
@@ -0,0 +1,33 @@
+module Network.TLS.PostHandshake (
+    requestCertificate,
+    requestCertificateServer,
+    postHandshakeAuthWith,
+    postHandshakeAuthClientWith,
+) where
+
+import Network.TLS.Context.Internal
+import Network.TLS.Handshake.Client
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Server
+import Network.TLS.IO
+import Network.TLS.Struct13
+
+----------------------------------------------------------------
+
+-- | Post-handshake certificate request with TLS 1.3.  Returns 'False'
+-- if the request was impossible, i.e. the remote client supports
+-- post-handshake authentication or the connection is established in
+-- TLS 1.2. Returns 'True' if the client authentication succeeds. An
+-- exception is thrown if the authentication fails. Server only.
+requestCertificate :: Context -> IO Bool
+requestCertificate ctx =
+    checkValid ctx >> doRequestCertificate_ (ctxRoleParams ctx) ctx
+
+-- | Handle a post-handshake authentication flight with TLS 1.3.  This
+-- is called automatically by 'recvData', in a context where the read
+-- lock is already taken. Client only.
+postHandshakeAuthWith :: Context -> Handshake13 -> IO ()
+postHandshakeAuthWith ctx hs =
+    withWriteLock ctx $
+        handleException ctx $
+            doPostHandshakeAuthWith_ (ctxRoleParams ctx) ctx hs
diff --git a/Network/TLS/QUIC.hs b/Network/TLS/QUIC.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/QUIC.hs
@@ -0,0 +1,265 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- API to run the TLS handshake establishing a QUIC connection.
+--
+-- On the northbound API:
+--
+-- * QUIC starts a TLS client or server thread with 'tlsQUICClient' or
+--   'tlsQUICServer'.
+--
+--  TLS invokes QUIC callbacks to use the QUIC transport
+--
+-- * TLS uses 'quicSend' and 'quicRecv' to send and receive handshake message
+--   fragments.
+--
+-- * TLS calls 'quicInstallKeys' to provide to QUIC the traffic secrets it
+--   should use for encryption/decryption.
+--
+-- * TLS calls 'quicNotifyExtensions' to notify to QUIC the transport parameters
+--   exchanged through the handshake protocol.
+--
+-- * TLS calls 'quicDone' when the handshake is done.
+module Network.TLS.QUIC (
+    -- * Handshakers
+    tlsQUICClient,
+    tlsQUICServer,
+
+    -- * Callback
+    QUICCallbacks (..),
+    CryptLevel (..),
+    KeyScheduleEvent (..),
+
+    -- * Secrets
+    EarlySecretInfo (..),
+    HandshakeSecretInfo (..),
+    ApplicationSecretInfo (..),
+    EarlySecret,
+    HandshakeSecret,
+    ApplicationSecret,
+    TrafficSecrets,
+    ServerTrafficSecret (..),
+    ClientTrafficSecret (..),
+
+    -- * Negotiated parameters
+    NegotiatedProtocol,
+    HandshakeMode13 (..),
+
+    -- * Extensions
+    ExtensionRaw (..),
+    ExtensionID (ExtensionID, EID_QuicTransportParameters),
+
+    -- * Errors
+    errorTLS,
+    errorToAlertDescription,
+    errorToAlertMessage,
+    fromAlertDescription,
+    toAlertDescription,
+
+    -- * Hash
+    hkdfExpandLabel,
+    hkdfExtract,
+    hashDigestSize,
+
+    -- * Constants
+    quicMaxEarlyDataSize,
+
+    -- * Supported
+    defaultSupported,
+) where
+
+import Data.Default (def)
+
+import Network.TLS.Backend
+import Network.TLS.Context
+import Network.TLS.Context.Internal
+import Network.TLS.Core
+import Network.TLS.Crypto (hashDigestSize)
+import Network.TLS.Crypto.Types
+import Network.TLS.Extension
+import Network.TLS.Extra.Cipher
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Control
+import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
+import Network.TLS.Imports
+import Network.TLS.KeySchedule (hkdfExpandLabel, hkdfExtract)
+import Network.TLS.Parameters hiding (defaultSupported)
+import Network.TLS.Record.Layer
+import Network.TLS.Record.State
+import Network.TLS.Struct
+import Network.TLS.Types
+
+nullBackend :: Backend
+nullBackend =
+    Backend
+        { backendFlush = return ()
+        , backendClose = return ()
+        , backendSend = \_ -> return ()
+        , backendRecv = \_ -> return ""
+        }
+
+-- | Argument given to 'quicInstallKeys' when encryption material is available.
+data KeyScheduleEvent
+    = -- | Key material and parameters for traffic at 0-RTT level
+      InstallEarlyKeys (Maybe EarlySecretInfo)
+    | -- | Key material and parameters for traffic at handshake level
+      InstallHandshakeKeys HandshakeSecretInfo
+    | -- | Key material and parameters for traffic at application level
+      InstallApplicationKeys ApplicationSecretInfo
+
+-- | Callbacks implemented by QUIC and to be called by TLS at specific points
+-- during the handshake.  TLS may invoke them from external threads but calls
+-- are not concurrent.  Only a single callback function is called at a given
+-- point in time.
+data QUICCallbacks = QUICCallbacks
+    { quicSend :: [(CryptLevel, ByteString)] -> IO ()
+    -- ^ Called by TLS so that QUIC sends one or more handshake fragments. The
+    -- content transiting on this API is the plaintext of the fragments and
+    -- QUIC responsibility is to encrypt this payload with the key material
+    -- given for the specified level and an appropriate encryption scheme.
+    --
+    -- The size of the fragments may exceed QUIC datagram limits so QUIC may
+    -- break them into smaller fragments.
+    --
+    -- The handshake protocol sometimes combines content at two levels in a
+    -- single flight.  The TLS library does its best to provide this in the
+    -- same @quicSend@ call and with a multi-valued argument.  QUIC can then
+    -- decide how to transmit this optimally.
+    , quicRecv :: CryptLevel -> IO (Either TLSError ByteString)
+    -- ^ Called by TLS to receive from QUIC the next plaintext handshake
+    -- fragment.  The argument specifies with which encryption level the
+    -- fragment should be decrypted.
+    --
+    -- QUIC may return partial fragments to TLS.  TLS will then call
+    -- @quicRecv@ again as long as necessary.  Note however that fragments
+    -- must be returned in the correct sequence, i.e. the order the TLS peer
+    -- emitted them.
+    --
+    -- The function may return an error to TLS if end of stream is reached or
+    -- if a protocol error has been received, believing the handshake cannot
+    -- proceed any longer.  If the TLS handshake protocol cannot recover from
+    -- this error, the failure condition will be reported back to QUIC through
+    -- the control interface.
+    , quicInstallKeys :: Context -> KeyScheduleEvent -> IO ()
+    -- ^ Called by TLS when new encryption material is ready to be used in the
+    -- handshake.  The next 'quicSend' or 'quicRecv' may now use the
+    -- associated encryption level (although the previous level is also
+    -- possible: directions Send/Recv do not change at the same time).
+    , quicNotifyExtensions :: Context -> [ExtensionRaw] -> IO ()
+    -- ^ Called by TLS when QUIC-specific extensions have been received from
+    -- the peer.
+    , quicDone :: Context -> IO ()
+    -- ^ Called when 'handshake' is done. 'tlsQUICServer' is
+    -- finished after calling this hook. 'tlsQUICClient' calls
+    -- 'recvData' after calling this hook to wait for new session
+    -- tickets.
+    }
+
+newRecordLayer
+    :: QUICCallbacks
+    -> RecordLayer [(CryptLevel, ByteString)]
+newRecordLayer callbacks = newTransparentRecordLayer get send recv
+  where
+    get = getTxLevel
+    send = quicSend callbacks
+    recv ctx = getRxLevel ctx >>= quicRecv callbacks
+
+-- | Start a TLS handshake thread for a QUIC client.  The client will use the
+-- specified TLS parameters and call the provided callback functions to send and
+-- receive handshake data.
+tlsQUICClient :: ClientParams -> QUICCallbacks -> IO ()
+tlsQUICClient cparams callbacks = do
+    ctx0 <- contextNew nullBackend cparams
+    mylimref <- newRecordLimitRef Nothing
+    peerlimref <- newRecordLimitRef Nothing
+    let ctx1 =
+            ctx0
+                { ctxHandshakeSync = HandshakeSync sync (\_ _ -> return ())
+                , ctxMyRecordLimit = mylimref
+                , ctxPeerRecordLimit = peerlimref
+                , ctxQUICMode = True
+                }
+        rl = newRecordLayer callbacks
+        ctx2 = updateRecordLayer rl ctx1
+    handshake ctx2
+    quicDone callbacks ctx2
+    void $ recvData ctx2 -- waiting for new session tickets
+  where
+    sync ctx (SendClientHello mEarlySecInfo) =
+        quicInstallKeys callbacks ctx (InstallEarlyKeys mEarlySecInfo)
+    sync ctx (RecvServerHello handSecInfo) =
+        quicInstallKeys callbacks ctx (InstallHandshakeKeys handSecInfo)
+    sync ctx (SendClientFinished exts appSecInfo) = do
+        let qexts = filterQTP exts
+        when (null qexts) $ do
+            throwCore $
+                Error_Protocol "QUIC transport parameters are missing" MissingExtension
+        quicNotifyExtensions callbacks ctx qexts
+        quicInstallKeys callbacks ctx (InstallApplicationKeys appSecInfo)
+
+-- | Start a TLS handshake thread for a QUIC server.  The server will use the
+-- specified TLS parameters and call the provided callback functions to send and
+-- receive handshake data.
+tlsQUICServer :: ServerParams -> QUICCallbacks -> IO ()
+tlsQUICServer sparams callbacks = do
+    ctx0 <- contextNew nullBackend sparams
+    mylimref <- newRecordLimitRef Nothing
+    peerlimref <- newRecordLimitRef Nothing
+    let ctx1 =
+            ctx0
+                { ctxHandshakeSync = HandshakeSync (\_ _ -> return ()) sync
+                , ctxMyRecordLimit = mylimref
+                , ctxPeerRecordLimit = peerlimref
+                , ctxQUICMode = True
+                }
+        rl = newRecordLayer callbacks
+        ctx2 = updateRecordLayer rl ctx1
+    handshake ctx2
+    quicDone callbacks ctx2
+  where
+    sync ctx (SendServerHello exts mEarlySecInfo handSecInfo) = do
+        let qexts = filterQTP exts
+        when (null qexts) $ do
+            throwCore $
+                Error_Protocol "QUIC transport parameters are missing" MissingExtension
+        quicNotifyExtensions callbacks ctx qexts
+        quicInstallKeys callbacks ctx (InstallEarlyKeys mEarlySecInfo)
+        quicInstallKeys callbacks ctx (InstallHandshakeKeys handSecInfo)
+    sync ctx (SendServerFinished appSecInfo) =
+        quicInstallKeys callbacks ctx (InstallApplicationKeys appSecInfo)
+
+filterQTP :: [ExtensionRaw] -> [ExtensionRaw]
+filterQTP =
+    filter
+        (\(ExtensionRaw eid _) -> eid == EID_QuicTransportParameters)
+
+-- | Can be used by callbacks to signal an unexpected condition.  This will then
+-- generate an "internal_error" alert in the TLS stack.
+errorTLS :: String -> IO a
+errorTLS msg = throwCore $ Error_Protocol msg InternalError
+
+-- | Return the alert that a TLS endpoint would send to the peer for the
+-- specified library error.
+errorToAlertDescription :: TLSError -> AlertDescription
+errorToAlertDescription = snd . errorToAlert
+
+-- | Decode an alert from the assigned value.
+toAlertDescription :: Word8 -> AlertDescription
+toAlertDescription = AlertDescription
+
+defaultSupported :: Supported
+defaultSupported =
+    def
+        { supportedVersions = [TLS13]
+        , supportedCiphers =
+            [ cipher13_AES_256_GCM_SHA384
+            , cipher13_AES_128_GCM_SHA256
+            , cipher13_AES_128_CCM_SHA256
+            ]
+        , supportedGroups = [X25519, X448, P256, P384, P521]
+        }
+
+-- | Max early data size for QUIC.
+quicMaxEarlyDataSize :: Int
+quicMaxEarlyDataSize = 0xffffffff
diff --git a/Network/TLS/RNG.hs b/Network/TLS/RNG.hs
--- a/Network/TLS/RNG.hs
+++ b/Network/TLS/RNG.hs
@@ -1,17 +1,30 @@
-{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
-module Network.TLS.RNG
-    ( StateRNG(..)
-    , withTLSRNG
-    ) where
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
+module Network.TLS.RNG (
+    StateRNG (..),
+    Seed,
+    seedNew,
+    seedToInteger,
+    seedFromInteger,
+    withTLSRNG,
+    newStateRNG,
+    MonadRandom,
+    getRandomBytes,
+) where
+
 import Crypto.Random
 
-data StateRNG = forall g . CPRG g => StateRNG g
+newtype StateRNG = StateRNG ChaChaDRG
+    deriving (DRG)
 
 instance Show StateRNG where
     show _ = "rng[..]"
 
-withTLSRNG :: StateRNG -> (forall g . CPRG g => g -> (a,g)) -> (a, StateRNG)
-withTLSRNG (StateRNG rng) f = let (a, rng') = f rng
-                               in (a, StateRNG rng')
+withTLSRNG
+    :: StateRNG
+    -> MonadPseudoRandom StateRNG a
+    -> (a, StateRNG)
+withTLSRNG rng f = withDRG rng f
 
+newStateRNG :: Seed -> StateRNG
+newStateRNG seed = StateRNG $ drgNewSeed seed
diff --git a/Network/TLS/Receiving.hs b/Network/TLS/Receiving.hs
deleted file mode 100644
--- a/Network/TLS/Receiving.hs
+++ /dev/null
@@ -1,76 +0,0 @@
--- |
--- Module      : Network.TLS.Receiving
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- the Receiving module contains calls related to unmarshalling packets according
--- to the TLS state
---
-module Network.TLS.Receiving
-    ( processPacket
-    ) where
-
-import Control.Monad.State
-import Control.Monad.Error
-import Control.Concurrent.MVar
-
-import Network.TLS.Context.Internal
-import Network.TLS.Struct
-import Network.TLS.Record
-import Network.TLS.Packet
-import Network.TLS.Wire
-import Network.TLS.State
-import Network.TLS.Handshake.State
-import Network.TLS.Cipher
-import Network.TLS.Util
-
-import Data.Byteable
-
-processPacket :: Context -> Record Plaintext -> IO (Either TLSError Packet)
-
-processPacket _ (Record ProtocolType_AppData _ fragment) = return $ Right $ AppData $ toBytes fragment
-
-processPacket _ (Record ProtocolType_Alert _ fragment) = return (Alert `fmapEither` (decodeAlerts $ toBytes fragment))
-
-processPacket ctx (Record ProtocolType_ChangeCipherSpec _ fragment) =
-    case decodeChangeCipherSpec $ toBytes fragment of
-        Left err -> return $ Left err
-        Right _  -> do switchRxEncryption ctx
-                       return $ Right ChangeCipherSpec
-
-processPacket ctx (Record ProtocolType_Handshake ver fragment) = do
-    keyxchg <- getHState ctx >>= \hs -> return $ (hs >>= hstPendingCipher >>= Just . cipherKeyExchange)
-    usingState ctx $ do
-        npn     <- getExtensionNPN
-        let currentParams = CurrentParams
-                            { cParamsVersion     = ver
-                            , cParamsKeyXchgType = keyxchg
-                            , cParamsSupportNPN  = npn
-                            }
-        -- get back the optional continuation, and parse as many handshake record as possible.
-        mCont <- gets stHandshakeRecordCont
-        modify (\st -> st { stHandshakeRecordCont = Nothing })
-        hss   <- parseMany currentParams mCont (toBytes fragment)
-        return $ Handshake hss
-  where parseMany currentParams mCont bs =
-            case maybe decodeHandshakeRecord id mCont $ bs of
-                GotError err                -> throwError err
-                GotPartial cont             -> modify (\st -> st { stHandshakeRecordCont = Just cont }) >> return []
-                GotSuccess (ty,content)     ->
-                    either throwError (return . (:[])) $ decodeHandshake currentParams ty content
-                GotSuccessRemaining (ty,content) left ->
-                    case decodeHandshake currentParams ty content of
-                        Left err -> throwError err
-                        Right hh -> (hh:) `fmap` parseMany currentParams Nothing left
-
-processPacket _ (Record ProtocolType_DeprecatedHandshake _ fragment) =
-    case decodeDeprecatedHandshake $ toBytes fragment of
-        Left err -> return $ Left err
-        Right hs -> return $ Right $ Handshake [hs]
-
-switchRxEncryption :: Context -> IO ()
-switchRxEncryption ctx =
-    usingHState ctx (gets hstPendingRxState) >>= \rx ->
-    liftIO $ modifyMVar_ (ctxRxState ctx) (\_ -> return $ fromJust "rx-state" rx)
diff --git a/Network/TLS/Record.hs b/Network/TLS/Record.hs
--- a/Network/TLS/Record.hs
+++ b/Network/TLS/Record.hs
@@ -1,41 +1,36 @@
--- |
--- Module      : Network.TLS.Record
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- The Record Protocol takes messages to be transmitted, fragments the
--- data into manageable blocks, optionally compresses the data, applies
--- a MAC, encrypts, and transmits the result.  Received data is
--- decrypted, verified, decompressed, reassembled, and then delivered to
--- higher-level clients.
---
-module Network.TLS.Record
-    ( Record(..)
+-- | The Record Protocol takes messages to be transmitted, fragments
+-- the data into manageable blocks, optionally compresses the data,
+-- applies a MAC, encrypts, and transmits the result.  Received data
+-- is decrypted, verified, decompressed, reassembled, and then
+-- delivered to higher-level clients.
+module Network.TLS.Record (
+    Record (..),
+
     -- * Fragment manipulation types
-    , Fragment
-    , fragmentPlaintext
-    , fragmentCiphertext
-    , recordToRaw
-    , rawToRecord
-    , recordToHeader
-    , Plaintext
-    , Compressed
-    , Ciphertext
-    -- * Engage and disengage from the record layer
-    , engageRecord
-    , disengageRecord
+    Fragment,
+    fragmentGetBytes,
+    fragmentPlaintext,
+    fragmentCiphertext,
+    recordToRaw,
+    rawToRecord,
+    recordToHeader,
+    Plaintext,
+    Ciphertext,
+
+    -- * Encrypt and decrypt from the record layer
+    encryptRecord,
+    decryptRecord,
+
     -- * State tracking
-    , RecordM
-    , runRecordM
-    , RecordState(..)
-    , newRecordState
-    , getRecordVersion
-    , setRecordIV
-    ) where
+    RecordM,
+    runRecordM,
+    RecordState (..),
+    newRecordState,
+    getRecordVersion,
+    setRecordIV,
+) where
 
-import Network.TLS.Record.Types
-import Network.TLS.Record.Engage
-import Network.TLS.Record.Disengage
+import Network.TLS.Record.Decrypt
+import Network.TLS.Record.Encrypt
 import Network.TLS.Record.State
+import Network.TLS.Record.Types
diff --git a/Network/TLS/Record/Decrypt.hs b/Network/TLS/Record/Decrypt.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Record/Decrypt.hs
@@ -0,0 +1,207 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Network.TLS.Record.Decrypt (
+    decryptRecord,
+) where
+
+import Control.Monad.State.Strict
+import Crypto.Cipher.Types (AuthTag (..))
+import Data.ByteArray (convert)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Crypto
+import Network.TLS.ErrT
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Record.State
+import Network.TLS.Record.Types
+import Network.TLS.Struct
+import Network.TLS.Util
+import Network.TLS.Wire
+
+decryptRecord :: Record Ciphertext -> Int -> RecordM (Record Plaintext)
+decryptRecord record@(Record ct ver fragment) lim = do
+    st <- get
+    case stCipher st of
+        Nothing -> noDecryption
+        _ -> do
+            recOpts <- getRecordOptions
+            let mver = recordVersion recOpts
+            if recordTLS13 recOpts
+                then decryptData13 mver (fragmentGetBytes fragment) st
+                else onRecordFragment record $ fragmentUncipher $ \e ->
+                    decryptData mver record e st lim
+  where
+    noDecryption = onRecordFragment record $ fragmentUncipher $ checkPlainLimit lim
+    decryptData13 mver e st = case ct of
+        ProtocolType_AppData -> do
+            inner <- decryptData mver record e st (lim + 1)
+            case unInnerPlaintext inner of
+                Left message -> throwError $ Error_Protocol message UnexpectedMessage
+                Right (ct', d) -> return $ Record ct' ver $ fragmentPlaintext d
+        ProtocolType_ChangeCipherSpec -> noDecryption
+        ProtocolType_Alert -> noDecryption
+        _ ->
+            throwError $ Error_Protocol "illegal plain text" UnexpectedMessage
+
+unInnerPlaintext :: ByteString -> Either String (ProtocolType, ByteString)
+unInnerPlaintext inner =
+    case B.unsnoc dc of
+        Nothing -> Left $ unknownContentType13 (0 :: Word8)
+        Just (bytes, c)
+            | B.null bytes && ProtocolType c `elem` nonEmptyContentTypes ->
+                Left ("empty " ++ show (ProtocolType c) ++ " record disallowed")
+            | otherwise -> Right (ProtocolType c, bytes)
+  where
+    (dc, _pad) = B.spanEnd (== 0) inner
+    nonEmptyContentTypes = [ProtocolType_Handshake, ProtocolType_Alert]
+    unknownContentType13 c = "unknown TLS 1.3 content type: " ++ show c
+
+getCipherData :: Record a -> CipherData -> RecordM ByteString
+getCipherData (Record pt ver _) cdata = do
+    -- check if the MAC is valid.
+    macValid <- case cipherDataMAC cdata of
+        Nothing -> return True
+        Just digest -> do
+            let new_hdr = Header pt ver (fromIntegral $ B.length $ cipherDataContent cdata)
+            expected_digest <- makeDigest new_hdr $ cipherDataContent cdata
+            return (expected_digest == digest)
+
+    -- check if the padding is filled with the correct pattern if it exists
+    -- (before TLS10 this checks instead that the padding length is minimal)
+    paddingValid <- case cipherDataPadding cdata of
+        Nothing -> return True
+        Just (pad, _blksz) -> do
+            let b = B.length pad - 1
+            return $ B.replicate (B.length pad) (fromIntegral b) == pad
+
+    unless (macValid &&! paddingValid) $
+        throwError $
+            Error_Protocol "bad record mac Stream/Block" BadRecordMac
+
+    return $ cipherDataContent cdata
+
+checkPlainLimit :: Int -> ByteString -> RecordM ByteString
+checkPlainLimit lim plain
+    | len > lim =
+        throwError $
+            Error_Protocol
+                ( "plaintext exceeding record size limit: "
+                    ++ show len
+                    ++ " > "
+                    ++ show lim
+                )
+                RecordOverflow
+    | otherwise = return plain
+  where
+    len = B.length plain
+
+decryptData
+    :: Version
+    -> Record Ciphertext
+    -> ByteString
+    -> RecordState
+    -> Int
+    -> RecordM ByteString
+decryptData ver record econtent tst lim =
+    decryptOf (cstKey cst) >>= checkPlainLimit lim
+  where
+    cipher = fromJust $ stCipher tst
+    bulk = cipherBulk cipher
+    cst = stCryptState tst
+    macSize = hashDigestSize $ cipherHash cipher
+    blockSize = bulkBlockSize bulk
+    econtentLen = B.length econtent
+
+    sanityCheckError =
+        throwError
+            (Error_Packet "encrypted content too small for encryption parameters")
+
+    decryptOf :: BulkState -> RecordM ByteString
+    decryptOf (BulkStateBlock decryptF) = do
+        let minContent = bulkIVSize bulk + max (macSize + 1) blockSize
+
+        -- check if we have enough bytes to cover the minimum for this cipher
+        when
+            ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent)
+            sanityCheckError
+
+        {- update IV -}
+        (iv, econtent') <-
+            get2o econtent (bulkIVSize bulk, econtentLen - bulkIVSize bulk)
+        let (content', iv') = decryptF iv econtent'
+        modify' $ \txs -> txs{stCryptState = cst{cstIV = iv'}}
+
+        let paddinglength = fromIntegral (B.last content') + 1
+        let contentlen = B.length content' - paddinglength - macSize
+        (content, mac, padding) <- get3i content' (contentlen, macSize, paddinglength)
+        getCipherData
+            record
+            CipherData
+                { cipherDataContent = content
+                , cipherDataMAC = Just mac
+                , cipherDataPadding = Just (padding, blockSize)
+                }
+    decryptOf (BulkStateStream (BulkStream decryptF)) = do
+        -- check if we have enough bytes to cover the minimum for this cipher
+        when (econtentLen < macSize) sanityCheckError
+
+        let (content', bulkStream') = decryptF econtent
+        {- update Ctx -}
+        let contentlen = B.length content' - macSize
+        (content, mac) <- get2i content' (contentlen, macSize)
+        modify' $ \txs -> txs{stCryptState = cst{cstKey = BulkStateStream bulkStream'}}
+        getCipherData
+            record
+            CipherData
+                { cipherDataContent = content
+                , cipherDataMAC = Just mac
+                , cipherDataPadding = Nothing
+                }
+    decryptOf (BulkStateAEAD decryptF) = do
+        let authTagLen = bulkAuthTagLen bulk
+            nonceExpLen = bulkExplicitIV bulk
+            cipherLen = econtentLen - authTagLen - nonceExpLen
+
+        -- check if we have enough bytes to cover the minimum for this cipher
+        when (econtentLen < (authTagLen + nonceExpLen)) sanityCheckError
+
+        (enonce, econtent', authTag) <-
+            get3o econtent (nonceExpLen, cipherLen, authTagLen)
+        let encodedSeq = encodeWord64 $ msSequence $ stMacState tst
+            iv = cstIV (stCryptState tst)
+            ivlen = B.length iv
+            Header typ v _ = recordToHeader record
+            hdrLen = if ver >= TLS13 then econtentLen else cipherLen
+            hdr = Header typ v $ fromIntegral hdrLen
+            ad
+                | ver >= TLS13 = encodeHeader hdr
+                | otherwise = B.concat [encodedSeq, encodeHeader hdr]
+            sqnc = B.replicate (ivlen - 8) 0 `B.append` encodedSeq
+            nonce
+                | nonceExpLen == 0 = BA.xor iv sqnc
+                | otherwise = iv `B.append` enonce
+            (content, authTag2) = decryptF nonce econtent' ad
+
+        when (AuthTag (convert authTag) /= authTag2) $
+            throwError $
+                Error_Protocol "bad record mac on AEAD" BadRecordMac
+
+        modify' incrRecordState
+        return content
+    decryptOf BulkStateUninitialized =
+        throwError $ Error_Protocol "decrypt state uninitialized" InternalError
+
+    -- handling of outer format can report errors with Error_Packet
+    get3o s ls =
+        maybe (throwError $ Error_Packet "record bad format") return $ partition3 s ls
+    get2o s (d1, d2) = get3o s (d1, d2, 0) >>= \(r1, r2, _) -> return (r1, r2)
+
+    -- all format errors related to decrypted content are reported
+    -- externally as integrity failures, i.e. BadRecordMac
+    get3i s ls =
+        maybe (throwError $ Error_Protocol "record bad format" BadRecordMac) return $
+            partition3 s ls
+    get2i s (d1, d2) = get3i s (d1, d2, 0) >>= \(r1, r2, _) -> return (r1, r2)
diff --git a/Network/TLS/Record/Disengage.hs b/Network/TLS/Record/Disengage.hs
deleted file mode 100644
--- a/Network/TLS/Record/Disengage.hs
+++ /dev/null
@@ -1,114 +0,0 @@
--- |
--- Module      : Network.TLS.Record.Disengage
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- Disengage a record from the Record layer.
--- The record is decrypted, checked for integrity and then decompressed.
---
-module Network.TLS.Record.Disengage
-        ( disengageRecord
-        ) where
-
-import Control.Monad.State
-import Control.Monad.Error
-
-import Network.TLS.Struct
-import Network.TLS.Cap
-import Network.TLS.Record.State
-import Network.TLS.Record.Types
-import Network.TLS.Cipher
-import Network.TLS.Compression
-import Network.TLS.Util
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-
-disengageRecord :: Record Ciphertext -> RecordM (Record Plaintext)
-disengageRecord = decryptRecord >=> uncompressRecord
-
-uncompressRecord :: Record Compressed -> RecordM (Record Plaintext)
-uncompressRecord record = onRecordFragment record $ fragmentUncompress $ \bytes ->
-    withCompression $ compressionInflate bytes
-
-decryptRecord :: Record Ciphertext -> RecordM (Record Compressed)
-decryptRecord record = onRecordFragment record $ fragmentUncipher $ \e -> do
-    st <- get
-    case stCipher st of
-        Nothing -> return e
-        _       -> getRecordVersion >>= \ver -> decryptData ver record e st
-
-getCipherData :: Record a -> CipherData -> RecordM ByteString
-getCipherData (Record pt ver _) cdata = do
-    -- check if the MAC is valid.
-    macValid <- case cipherDataMAC cdata of
-        Nothing     -> return True
-        Just digest -> do
-            let new_hdr = Header pt ver (fromIntegral $ B.length $ cipherDataContent cdata)
-            expected_digest <- makeDigest new_hdr $ cipherDataContent cdata
-            return (expected_digest `bytesEq` digest)
-
-    -- check if the padding is filled with the correct pattern if it exists
-    paddingValid <- case cipherDataPadding cdata of
-        Nothing  -> return True
-        Just pad -> do
-            cver <- getRecordVersion
-            let b = B.length pad - 1
-            return (if cver < TLS10 then True else B.replicate (B.length pad) (fromIntegral b) `bytesEq` pad)
-
-    unless (macValid &&! paddingValid) $ do
-        throwError $ Error_Protocol ("bad record mac", True, BadRecordMac)
-
-    return $ cipherDataContent cdata
-
-decryptData :: Version -> Record Ciphertext -> Bytes -> RecordState -> RecordM Bytes
-decryptData ver record econtent tst = decryptOf (bulkF bulk)
-  where cipher     = fromJust "cipher" $ stCipher tst
-        bulk       = cipherBulk cipher
-        cst        = stCryptState tst
-        macSize    = hashSize $ cipherHash cipher
-        writekey   = cstKey cst
-        blockSize  = bulkBlockSize bulk
-        econtentLen = B.length econtent
-
-        explicitIV = hasExplicitBlockIV ver
-
-        sanityCheckError = throwError (Error_Packet "encrypted content too small for encryption parameters")
-
-        decryptOf :: BulkFunctions -> RecordM Bytes
-        decryptOf (BulkBlockF _ decryptF) = do
-            let minContent = (if explicitIV then bulkIVSize bulk else 0) + max (macSize + 1) blockSize
-            when ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent) $ sanityCheckError
-            {- update IV -}
-            (iv, econtent') <- if explicitIV
-                                  then get2 econtent (bulkIVSize bulk, econtentLen - bulkIVSize bulk)
-                                  else return (cstIV cst, econtent)
-            let newiv = fromJust "new iv" $ takelast (bulkBlockSize bulk) econtent'
-            modify $ \txs -> txs { stCryptState = cst { cstIV = newiv } }
-
-            let content' = decryptF writekey iv econtent'
-            let paddinglength = fromIntegral (B.last content') + 1
-            let contentlen = B.length content' - paddinglength - macSize
-            (content, mac, padding) <- get3 content' (contentlen, macSize, paddinglength)
-            getCipherData record $ CipherData
-                    { cipherDataContent = content
-                    , cipherDataMAC     = Just mac
-                    , cipherDataPadding = Just padding
-                    }
-
-        decryptOf (BulkStreamF initF _ decryptF) = do
-            when (econtentLen < macSize) $ sanityCheckError
-            let (content', newiv) = decryptF (if cstIV cst /= B.empty then cstIV cst else initF writekey) econtent
-            {- update Ctx -}
-            let contentlen        = B.length content' - macSize
-            (content, mac) <- get2 content' (contentlen, macSize)
-            modify $ \txs -> txs { stCryptState = cst { cstIV = newiv } }
-            getCipherData record $ CipherData
-                    { cipherDataContent = content
-                    , cipherDataMAC     = Just mac
-                    , cipherDataPadding = Nothing
-                    }
-
-        get3 s ls = maybe (throwError $ Error_Packet "record bad format") return $ partition3 s ls
-        get2 s (d1,d2) = get3 s (d1,d2,0) >>= \(r1,r2,_) -> return (r1,r2)
diff --git a/Network/TLS/Record/Encrypt.hs b/Network/TLS/Record/Encrypt.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Record/Encrypt.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Engage a record into the Record layer.
+-- The record is compressed, added some integrity field, then encrypted.
+--
+-- Starting with TLS v1.3, only the "null" compression method is negotiated in
+-- the handshake, so the compression step will be a no-op.  Integrity and
+-- encryption are performed using an AEAD cipher only.
+module Network.TLS.Record.Encrypt (
+    encryptRecord,
+) where
+
+import Control.Monad.State.Strict
+import Crypto.Cipher.Types (AuthTag (..))
+import Data.ByteArray (convert)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Record.State
+import Network.TLS.Record.Types
+import Network.TLS.Wire
+
+-- when Tx Encrypted is set, we pass the data through encryptContent, otherwise
+-- we just return the compress payload directly as the ciphered one
+--
+encryptRecord :: Record Plaintext -> RecordM (Record Ciphertext)
+encryptRecord record@(Record ct ver fragment) = do
+    st <- get
+    case stCipher st of
+        Nothing -> noEncryption
+        _ -> do
+            recOpts <- getRecordOptions
+            if recordTLS13 recOpts
+                then encryptContent13
+                else onRecordFragment record $ fragmentCipher (encryptContent False record)
+  where
+    noEncryption = onRecordFragment record $ fragmentCipher return
+    encryptContent13
+        | ct == ProtocolType_ChangeCipherSpec = noEncryption
+        | otherwise = do
+            let bytes = fragmentGetBytes fragment
+                fragment' = fragmentPlaintext $ innerPlaintext ct bytes
+                record' = Record ProtocolType_AppData ver fragment'
+            onRecordFragment record' $ fragmentCipher (encryptContent True record')
+
+innerPlaintext :: ProtocolType -> ByteString -> ByteString
+innerPlaintext (ProtocolType c) bytes = runPut $ do
+    putBytes bytes
+    putWord8 c -- non zero!
+    -- fixme: zeros padding
+
+encryptContent :: Bool -> Record Plaintext -> ByteString -> RecordM ByteString
+encryptContent tls13 record content = do
+    cst <- getCryptState
+    bulk <- getBulk
+    case cstKey cst of
+        BulkStateBlock encryptF -> do
+            digest <- makeDigest (recordToHeader record) content
+            let content' = B.concat [content, digest]
+            encryptBlock encryptF content' bulk
+        BulkStateStream encryptF -> do
+            digest <- makeDigest (recordToHeader record) content
+            let content' = B.concat [content, digest]
+            encryptStream encryptF content'
+        BulkStateAEAD encryptF ->
+            encryptAead tls13 bulk encryptF content record
+        BulkStateUninitialized ->
+            return content
+
+encryptBlock :: BulkBlock -> ByteString -> Bulk -> RecordM ByteString
+encryptBlock encryptF content bulk = do
+    cst <- getCryptState
+    let blockSize = fromIntegral $ bulkBlockSize bulk
+    let msg_len = B.length content
+    let padding =
+            if blockSize > 0
+                then
+                    let padbyte = blockSize - (msg_len `mod` blockSize)
+                     in let padbyte' = if padbyte == 0 then blockSize else padbyte
+                         in B.replicate padbyte' (fromIntegral (padbyte' - 1))
+                else B.empty
+
+    let (e, _iv') = encryptF (cstIV cst) $ B.concat [content, padding]
+
+    return $ B.concat [cstIV cst, e]
+
+encryptStream :: BulkStream -> ByteString -> RecordM ByteString
+encryptStream (BulkStream encryptF) content = do
+    cst <- getCryptState
+    let (!e, !newBulkStream) = encryptF content
+    modify' $ \tstate -> tstate{stCryptState = cst{cstKey = BulkStateStream newBulkStream}}
+    return e
+
+encryptAead
+    :: Bool
+    -> Bulk
+    -> BulkAEAD
+    -> ByteString
+    -> Record Plaintext
+    -> RecordM ByteString
+encryptAead tls13 bulk encryptF content record = do
+    let authTagLen = bulkAuthTagLen bulk
+        nonceExpLen = bulkExplicitIV bulk
+    cst <- getCryptState
+    encodedSeq <- encodeWord64 <$> getMacSequence
+
+    let iv = cstIV cst
+        ivlen = B.length iv
+        Header typ v plainLen = recordToHeader record
+        hdrLen = if tls13 then plainLen + fromIntegral authTagLen else plainLen
+        hdr = Header typ v hdrLen
+        ad
+            | tls13 = encodeHeader hdr
+            | otherwise = B.concat [encodedSeq, encodeHeader hdr]
+        sqnc = B.replicate (ivlen - 8) 0 `B.append` encodedSeq
+        nonce
+            | nonceExpLen == 0 = BA.xor iv sqnc
+            | otherwise = B.concat [iv, encodedSeq]
+        (e, AuthTag authtag) = encryptF nonce content ad
+        econtent
+            | nonceExpLen == 0 = e `B.append` convert authtag
+            | otherwise = B.concat [encodedSeq, e, convert authtag]
+    modify' incrRecordState
+    return econtent
+
+getCryptState :: RecordM CryptState
+getCryptState = stCryptState <$> get
diff --git a/Network/TLS/Record/Engage.hs b/Network/TLS/Record/Engage.hs
deleted file mode 100644
--- a/Network/TLS/Record/Engage.hs
+++ /dev/null
@@ -1,84 +0,0 @@
--- |
--- Module      : Network.TLS.Record.Engage
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- Engage a record into the Record layer.
--- The record is compressed, added some integrity field, then encrypted.
---
-module Network.TLS.Record.Engage
-        ( engageRecord
-        ) where
-
-import Control.Monad.State
-
-import Network.TLS.Cap
-import Network.TLS.Record.State
-import Network.TLS.Record.Types
-import Network.TLS.Cipher
-import Network.TLS.Compression
-import Network.TLS.Util
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-
-engageRecord :: Record Plaintext -> RecordM (Record Ciphertext)
-engageRecord = compressRecord >=> encryptRecord
-
-compressRecord :: Record Plaintext -> RecordM (Record Compressed)
-compressRecord record =
-    onRecordFragment record $ fragmentCompress $ \bytes -> do
-        withCompression $ compressionDeflate bytes
-
-{-
- - when Tx Encrypted is set, we pass the data through encryptContent, otherwise
- - we just return the packet
- -}
-encryptRecord :: Record Compressed -> RecordM (Record Ciphertext)
-encryptRecord record = onRecordFragment record $ fragmentCipher $ \bytes -> do
-    st <- get
-    case stCipher st of
-        Nothing -> return bytes
-        _       -> encryptContent record bytes
-
-encryptContent :: Record Compressed -> ByteString -> RecordM ByteString
-encryptContent record content = do
-    digest <- makeDigest (recordToHeader record) content
-    encryptData $ B.concat [content, digest]
-
-encryptData :: ByteString -> RecordM ByteString
-encryptData content = do
-    tstate <- get
-    ver    <- getRecordVersion
-
-    let cipher = fromJust "cipher" $ stCipher tstate
-    let bulk = cipherBulk cipher
-    let cst = stCryptState tstate
-
-    let writekey = cstKey cst
-
-    case bulkF bulk of
-        BulkBlockF encrypt _ -> do
-            let blockSize = fromIntegral $ bulkBlockSize bulk
-            let msg_len = B.length content
-            let padding = if blockSize > 0
-                    then
-                            let padbyte = blockSize - (msg_len `mod` blockSize) in
-                            let padbyte' = if padbyte == 0 then blockSize else padbyte in
-                            B.replicate padbyte' (fromIntegral (padbyte' - 1))
-                    else
-                            B.empty
-
-            let e = encrypt writekey (cstIV cst) (B.concat [ content, padding ])
-            if hasExplicitBlockIV ver
-                    then return $ B.concat [cstIV cst,e]
-                    else do
-                            let newiv = fromJust "new iv" $ takelast (bulkIVSize bulk) e
-                            put $ tstate { stCryptState = cst { cstIV = newiv } }
-                            return e
-        BulkStreamF initF encryptF _ -> do
-            let iv = cstIV cst
-            let (e, newiv) = encryptF (if iv /= B.empty then iv else initF writekey) content
-            put $ tstate { stCryptState = cst { cstIV = newiv } }
-            return e
diff --git a/Network/TLS/Record/Layer.hs b/Network/TLS/Record/Layer.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Record/Layer.hs
@@ -0,0 +1,64 @@
+module Network.TLS.Record.Layer (
+    RecordLayer (..),
+    newTransparentRecordLayer,
+) where
+
+import Network.TLS.Context
+import Network.TLS.Imports
+import Network.TLS.Record
+import Network.TLS.Struct
+
+import qualified Data.ByteString as B
+
+newTransparentRecordLayer
+    :: Eq ann
+    => (Context -> IO ann)
+    -> ([(ann, ByteString)] -> IO ())
+    -> (Context -> IO (Either TLSError ByteString))
+    -> RecordLayer [(ann, ByteString)]
+newTransparentRecordLayer get send recv =
+    RecordLayer
+        { recordEncode12 = transparentEncodeRecord get
+        , recordEncode13 = transparentEncodeRecord get
+        , recordSendBytes = transparentSendBytes send
+        , recordRecv12 = transparentRecvRecord recv
+        , recordRecv13 = transparentRecvRecord recv
+        }
+
+transparentEncodeRecord
+    :: (Context -> IO ann)
+    -> Context
+    -> Record Plaintext
+    -> IO (Either TLSError [(ann, ByteString)])
+transparentEncodeRecord _ _ (Record ProtocolType_ChangeCipherSpec _ _) =
+    return $ Right []
+transparentEncodeRecord _ _ (Record ProtocolType_Alert _ _) =
+    -- all alerts are silent and must be transported externally based on
+    -- TLS exceptions raised by the library
+    return $ Right []
+transparentEncodeRecord get ctx (Record _ _ frag) =
+    get ctx >>= \a -> return $ Right [(a, fragmentGetBytes frag)]
+
+transparentSendBytes
+    :: Eq ann
+    => ([(ann, ByteString)] -> IO ())
+    -> Context
+    -> [(ann, ByteString)]
+    -> IO ()
+transparentSendBytes send _ input =
+    send
+        [ (a, bs) | (a, frgs) <- compress input, let bs = B.concat frgs, not (B.null bs)
+        ]
+
+transparentRecvRecord
+    :: (Context -> IO (Either TLSError ByteString))
+    -> Context
+    -> IO (Either TLSError (Record Plaintext))
+transparentRecvRecord recv ctx =
+    fmap (Record ProtocolType_Handshake TLS12 . fragmentPlaintext) <$> recv ctx
+
+compress :: Eq ann => [(ann, val)] -> [(ann, [val])]
+compress [] = []
+compress ((a, v) : xs) =
+    let (ys, zs) = span ((== a) . fst) xs
+     in (a, v : map snd ys) : compress zs
diff --git a/Network/TLS/Record/Recv.hs b/Network/TLS/Record/Recv.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Record/Recv.hs
@@ -0,0 +1,112 @@
+-- | TLS record layer in Rx direction
+module Network.TLS.Record.Recv (
+    recvRecord12,
+    recvRecord13,
+) where
+
+import qualified Data.ByteString as B
+
+import Network.TLS.Context.Internal
+import Network.TLS.Hooks
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Record
+import Network.TLS.Struct
+import Network.TLS.Types
+
+----------------------------------------------------------------
+
+getMyPlainLimit :: Context -> IO Int
+getMyPlainLimit ctx = do
+    msiz <- getMyRecordLimit ctx
+    return $ case msiz of
+        Nothing -> defaultRecordSizeLimit
+        Just siz -> siz
+
+getRecord
+    :: Context
+    -> Header
+    -> ByteString
+    -> IO (Either TLSError (Record Plaintext))
+getRecord ctx header content = do
+    withLog ctx $ \logging -> loggingIORecv logging header content
+    lim <- getMyPlainLimit ctx
+    runRxRecordState ctx $ do
+        let erecord = rawToRecord header $ fragmentCiphertext content
+        decryptRecord erecord lim
+
+----------------------------------------------------------------
+
+exceedsTLSCiphertext :: Int -> Word16 -> Bool
+exceedsTLSCiphertext overhead actual =
+    -- In TLS 1.3, overhead is included one more byte for content type.
+    fromIntegral actual > defaultRecordSizeLimit + overhead
+
+-- | recvRecord receive a full TLS record (header + data), from the other side.
+--
+-- The record is disengaged from the record layer
+recvRecord12
+    :: Context
+    -- ^ TLS context
+    -> IO (Either TLSError (Record Plaintext))
+recvRecord12 ctx =
+    readExactBytes ctx 5 >>= either (return . Left) (recvLengthE . decodeHeader)
+  where
+    recvLengthE = either (return . Left) recvLength
+
+    recvLength header@(Header _ _ readlen) = do
+        -- RFC 5246 Section 7.2.2
+        -- A TLSCiphertext record was received that had a length more
+        -- than 2^14+2048 bytes, or a record decrypted to a
+        -- TLSCompressed record with more than 2^14+1024 bytes.  This
+        -- message is always fatal and should never be observed in
+        -- communication between proper implementations (except when
+        -- messages were corrupted in the network).
+        if exceedsTLSCiphertext 2048 readlen
+            then return $ Left maximumSizeExceeded
+            else
+                readExactBytes ctx (fromIntegral readlen)
+                    >>= either (return . Left) (getRecord ctx header)
+
+recvRecord13 :: Context -> IO (Either TLSError (Record Plaintext))
+recvRecord13 ctx = readExactBytes ctx 5 >>= either (return . Left) (recvLengthE . decodeHeader)
+  where
+    recvLengthE = either (return . Left) recvLength
+    recvLength header@(Header _ _ readlen) = do
+        -- RFC 8446 Section 5.2:
+        -- An AEAD algorithm used in TLS 1.3 MUST NOT produce an
+        -- expansion greater than 255 octets.  An endpoint that
+        -- receives a record from its peer with TLSCiphertext.length
+        -- larger than 2^14 + 256 octets MUST terminate the connection
+        -- with a "record_overflow" alert.  This limit is derived from
+        -- the maximum TLSInnerPlaintext length of 2^14 octets + 1
+        -- octet for ContentType + the maximum AEAD expansion of 255
+        -- octets.
+        if exceedsTLSCiphertext 256 readlen
+            then return $ Left maximumSizeExceeded
+            else
+                readExactBytes ctx (fromIntegral readlen)
+                    >>= either (return . Left) (getRecord ctx header)
+
+maximumSizeExceeded :: TLSError
+maximumSizeExceeded = Error_Protocol "record exceeding maximum size" RecordOverflow
+
+----------------------------------------------------------------
+
+readExactBytes :: Context -> Int -> IO (Either TLSError ByteString)
+readExactBytes ctx sz = do
+    hdrbs <- contextRecv ctx sz
+    if B.length hdrbs == sz
+        then return $ Right hdrbs
+        else do
+            setEOF ctx
+            return . Left $
+                if B.null hdrbs
+                    then Error_EOF
+                    else
+                        Error_Packet
+                            ( "partial packet: expecting "
+                                ++ show sz
+                                ++ " bytes, got: "
+                                ++ show (B.length hdrbs)
+                            )
diff --git a/Network/TLS/Record/Send.hs b/Network/TLS/Record/Send.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Record/Send.hs
@@ -0,0 +1,61 @@
+-- | TLS record layer in Tx direction
+module Network.TLS.Record.Send (
+    encodeRecord12,
+    encodeRecord13,
+    sendBytes,
+) where
+
+import Control.Concurrent.MVar
+import Control.Monad.State.Strict
+import qualified Data.ByteString as B
+
+import Network.TLS.Cipher
+import Network.TLS.Context.Internal
+import Network.TLS.Hooks
+import Network.TLS.Imports
+import Network.TLS.Packet
+import Network.TLS.Record
+import Network.TLS.Struct
+
+encodeRecordM :: Record Plaintext -> RecordM ByteString
+encodeRecordM record = do
+    erecord <- encryptRecord record
+    let (hdr, content) = recordToRaw erecord
+    return $ B.concat [encodeHeader hdr, content]
+
+----------------------------------------------------------------
+
+encodeRecord12 :: Context -> Record Plaintext -> IO (Either TLSError ByteString)
+encodeRecord12 ctx = prepareRecord12 ctx . encodeRecordM
+
+-- before TLS 1.1, the block cipher IV is made of the residual of the previous block,
+-- so we use cstIV as is, however in other case we generate an explicit IV
+prepareRecord12 :: Context -> RecordM a -> IO (Either TLSError a)
+prepareRecord12 ctx f = do
+    txState <- readMVar $ ctxTxRecordState ctx
+    let sz = case stCipher txState of
+            Nothing -> 0
+            Just cipher ->
+                if hasRecordIV $ bulkF $ cipherBulk cipher
+                    then bulkIVSize $ cipherBulk cipher
+                    else 0 -- to not generate IV
+    if sz > 0
+        then do
+            newIV <- getStateRNG ctx sz
+            runTxRecordState ctx (modify' (setRecordIV newIV) >> f)
+        else runTxRecordState ctx f
+
+----------------------------------------------------------------
+
+encodeRecord13 :: Context -> Record Plaintext -> IO (Either TLSError ByteString)
+encodeRecord13 ctx = prepareRecord13 ctx . encodeRecordM
+
+prepareRecord13 :: Context -> RecordM a -> IO (Either TLSError a)
+prepareRecord13 = runTxRecordState
+
+----------------------------------------------------------------
+
+sendBytes :: Context -> ByteString -> IO ()
+sendBytes ctx dataToSend = do
+    withLog ctx $ \logging -> loggingIOSent logging dataToSend
+    contextSend ctx dataToSend
diff --git a/Network/TLS/Record/State.hs b/Network/TLS/Record/State.hs
--- a/Network/TLS/Record/State.hs
+++ b/Network/TLS/Record/State.hs
@@ -1,135 +1,177 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE CPP #-}
--- |
--- Module      : Network.TLS.Record.State
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Record.State
-    ( CryptState(..)
-    , MacState(..)
-    , RecordState(..)
-    , newRecordState
-    , RecordM
-    , runRecordM
-    , getRecordVersion
-    , setRecordIV
-    , withCompression
-    , computeDigest
-    , makeDigest
-    ) where
 
-import Data.Word
-import Control.Applicative
-import Control.Monad.State
-import Control.Monad.Error
-import Network.TLS.Compression
+module Network.TLS.Record.State (
+    CryptState (..),
+    CryptLevel (..),
+    HasCryptLevel (..),
+    MacState (..),
+    RecordOptions (..),
+    RecordState (..),
+    newRecordState,
+    incrRecordState,
+    RecordM,
+    runRecordM,
+    getRecordOptions,
+    getRecordVersion,
+    setRecordIV,
+    withCompression,
+    computeDigest,
+    makeDigest,
+    getBulk,
+    getMacSequence,
+) where
+
+import Control.Monad.State.Strict
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
+
 import Network.TLS.Cipher
+import Network.TLS.Compression
+import Network.TLS.ErrT
+import Network.TLS.Imports
+import Network.TLS.MAC
+import Network.TLS.Packet
 import Network.TLS.Struct
+import Network.TLS.Types
 import Network.TLS.Wire
 
-import Network.TLS.Packet
-import Network.TLS.MAC
-import Network.TLS.Util
-
-import qualified Data.ByteString as B
-
 data CryptState = CryptState
-    { cstKey        :: !Bytes
-    , cstIV         :: !Bytes
-    , cstMacSecret  :: !Bytes
-    } deriving (Show)
+    { cstKey :: BulkState
+    , cstIV :: IV
+    , -- In TLS 1.2 or earlier, this holds mac secret.
+      -- In TLS 1.3, this holds application traffic secret N.
+      cstMacSecret :: Secret
+    }
+    deriving (Show)
 
 newtype MacState = MacState
     { msSequence :: Word64
-    } deriving (Show)
+    }
+    deriving (Show)
 
+data RecordOptions = RecordOptions
+    { recordVersion :: Version -- version to use when sending/receiving
+    , recordTLS13 :: Bool -- TLS13 record processing
+    }
+
+-- | TLS encryption level.
+data CryptLevel
+    = -- | Unprotected traffic
+      CryptInitial
+    | -- | Protected with main secret (TLS < 1.3)
+      CryptMainSecret
+    | -- | Protected with early traffic secret (TLS 1.3)
+      CryptEarlySecret
+    | -- | Protected with handshake traffic secret (TLS 1.3)
+      CryptHandshakeSecret
+    | -- | Protected with application traffic secret (TLS 1.3)
+      CryptApplicationSecret
+    deriving (Eq, Show)
+
+class HasCryptLevel a where getCryptLevel :: proxy a -> CryptLevel
+instance HasCryptLevel EarlySecret where getCryptLevel _ = CryptEarlySecret
+instance HasCryptLevel HandshakeSecret where
+    getCryptLevel _ = CryptHandshakeSecret
+instance HasCryptLevel ApplicationSecret where
+    getCryptLevel _ = CryptApplicationSecret
+
 data RecordState = RecordState
-    { stCipher      :: Maybe Cipher
+    { stCipher :: Maybe Cipher
     , stCompression :: Compression
-    , stCryptState  :: !CryptState
-    , stMacState    :: !MacState
-    } deriving (Show)
+    , stCryptLevel :: CryptLevel
+    , stCryptState :: CryptState
+    , stMacState :: MacState
+    }
+    deriving (Show)
 
-newtype RecordM a = RecordM { runRecordM :: Version
-                                         -> RecordState
-                                         -> Either TLSError (a, RecordState) }
+newtype RecordM a = RecordM
+    { runRecordM
+        :: RecordOptions
+        -> RecordState
+        -> Either TLSError (a, RecordState)
+    }
 
 instance Applicative RecordM where
-    pure = return
+    pure a = RecordM $ \_ st -> Right (a, st)
     (<*>) = ap
 
 instance Monad RecordM where
-    return a  = RecordM $ \_ st  -> Right (a, st)
-    m1 >>= m2 = RecordM $ \ver st -> do
-                    case runRecordM m1 ver st of
-                        Left err       -> Left err
-                        Right (a, st2) -> runRecordM (m2 a) ver st2
+    m1 >>= m2 = RecordM $ \opt st ->
+        case runRecordM m1 opt st of
+            Left err -> Left err
+            Right (a, st2) -> runRecordM (m2 a) opt st2
 
 instance Functor RecordM where
-    fmap f m = RecordM $ \ver st ->
-                case runRecordM m ver st of
-                    Left err       -> Left err
-                    Right (a, st2) -> Right (f a, st2)
+    fmap f m = RecordM $ \opt st ->
+        case runRecordM m opt st of
+            Left err -> Left err
+            Right (a, st2) -> Right (f a, st2)
 
+getRecordOptions :: RecordM RecordOptions
+getRecordOptions = RecordM $ \opt st -> Right (opt, st)
+
 getRecordVersion :: RecordM Version
-getRecordVersion = RecordM $ \ver st -> Right (ver, st)
+getRecordVersion = recordVersion <$> getRecordOptions
 
 instance MonadState RecordState RecordM where
-    put x = RecordM $ \_  _  -> Right ((), x)
-    get   = RecordM $ \_  st -> Right (st, st)
-#if MIN_VERSION_mtl(2,1,0)
+    put x = RecordM $ \_ _ -> Right ((), x)
+    get = RecordM $ \_ st -> Right (st, st)
     state f = RecordM $ \_ st -> Right (f st)
-#endif
 
 instance MonadError TLSError RecordM where
-    throwError e   = RecordM $ \_ _ -> Left e
-    catchError m f = RecordM $ \ver st ->
-                        case runRecordM m ver st of
-                            Left err -> runRecordM (f err) ver st
-                            r        -> r
+    throwError e = RecordM $ \_ _ -> Left e
+    catchError m f = RecordM $ \opt st ->
+        case runRecordM m opt st of
+            Left err -> runRecordM (f err) opt st
+            r -> r
 
 newRecordState :: RecordState
-newRecordState = RecordState
-    { stCipher      = Nothing
-    , stCompression = nullCompression
-    , stCryptState  = CryptState B.empty B.empty B.empty
-    , stMacState    = MacState 0
-    }
+newRecordState =
+    RecordState
+        { stCipher = Nothing
+        , stCompression = nullCompression
+        , stCryptLevel = CryptInitial
+        , stCryptState = CryptState BulkStateUninitialized B.empty BA.empty
+        , stMacState = MacState 0
+        }
 
 incrRecordState :: RecordState -> RecordState
-incrRecordState ts = ts { stMacState = MacState (ms + 1) }
-  where (MacState ms) = stMacState ts
+incrRecordState ts = ts{stMacState = MacState (ms + 1)}
+  where
+    (MacState ms) = stMacState ts
 
-setRecordIV :: Bytes -> RecordState -> RecordState
-setRecordIV iv st = st { stCryptState = (stCryptState st) { cstIV = iv } }
+setRecordIV :: ByteString -> RecordState -> RecordState
+setRecordIV iv st = st{stCryptState = (stCryptState st){cstIV = iv}}
 
 withCompression :: (Compression -> (Compression, a)) -> RecordM a
 withCompression f = do
     st <- get
     let (nc, a) = f $ stCompression st
-    put $ st { stCompression = nc }
+    put $ st{stCompression = nc}
     return a
 
-computeDigest :: Version -> RecordState -> Header -> Bytes -> (Bytes, RecordState)
-computeDigest ver tstate hdr content = (digest, incrRecordState tstate)
-  where digest = macF (cstMacSecret cst) msg
-        cst    = stCryptState tstate
-        cipher = fromJust "cipher" $ stCipher tstate
-        hashf  = hashF $ cipherHash cipher
-        encodedSeq = encodeWord64 $ msSequence $ stMacState tstate
+computeDigest
+    :: Version -> RecordState -> Header -> ByteString -> (ByteString, RecordState)
+computeDigest _ver tstate hdr content = (digest, incrRecordState tstate)
+  where
+    digest = BA.convert $ macF (cstMacSecret cst) msg
+    cst = stCryptState tstate
+    cipher = fromJust $ stCipher tstate
+    hashA = cipherHash cipher
+    encodedSeq = encodeWord64 $ msSequence $ stMacState tstate
 
-        (macF, msg)
-            | ver < TLS10 = (macSSL hashf, B.concat [ encodedSeq, encodeHeaderNoVer hdr, content ])
-            | otherwise   = (hmac hashf 64, B.concat [ encodedSeq, encodeHeader hdr, content ])
+    (macF, msg) = (hmac hashA, B.concat [encodedSeq, encodeHeader hdr, content])
 
-makeDigest :: Header -> Bytes -> RecordM Bytes
+makeDigest :: Header -> ByteString -> RecordM ByteString
 makeDigest hdr content = do
     ver <- getRecordVersion
     st <- get
     let (digest, nstate) = computeDigest ver st hdr content
     put nstate
     return digest
+
+getBulk :: RecordM Bulk
+getBulk = cipherBulk . fromJust . stCipher <$> get
+
+getMacSequence :: RecordM Word64
+getMacSequence = msSequence . stMacState <$> get
diff --git a/Network/TLS/Record/Types.hs b/Network/TLS/Record/Types.hs
--- a/Network/TLS/Record/Types.hs
+++ b/Network/TLS/Record/Types.hs
@@ -1,90 +1,81 @@
 {-# LANGUAGE EmptyDataDecls #-}
--- |
--- Module      : Network.TLS.Record.Types
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- The Record Protocol takes messages to be transmitted, fragments the
--- data into manageable blocks, optionally compresses the data, applies
--- a MAC, encrypts, and transmits the result.  Received data is
--- decrypted, verified, decompressed, reassembled, and then delivered to
--- higher-level clients.
---
-module Network.TLS.Record.Types
-    ( Header(..)
-    , ProtocolType(..)
-    , packetType
+
+-- | The Record Protocol takes messages to be transmitted, fragments
+-- the data into manageable blocks.  applies a MAC, encrypts, and
+-- transmits the result.  Received data is decrypted, verified,
+-- reassembled, and then delivered to higher-level clients.
+module Network.TLS.Record.Types (
+    Header (..),
+    ProtocolType (..),
+    packetType,
+
     -- * TLS Records
-    , Record(..)
+    Record (..),
+
     -- * TLS Record fragment and constructors
-    , Fragment
-    , fragmentPlaintext
-    , fragmentCiphertext
-    , Plaintext
-    , Compressed
-    , Ciphertext
+    Fragment,
+    fragmentGetBytes,
+    fragmentPlaintext,
+    fragmentCiphertext,
+    Plaintext,
+    Ciphertext,
+
     -- * manipulate record
-    , onRecordFragment
-    , fragmentCompress
-    , fragmentCipher
-    , fragmentUncipher
-    , fragmentUncompress
+    onRecordFragment,
+    fragmentCipher,
+    fragmentUncipher,
+
     -- * serialize record
-    , rawToRecord
-    , recordToRaw
-    , recordToHeader
-    ) where
+    rawToRecord,
+    recordToRaw,
+    recordToHeader,
+) where
 
-import Network.TLS.Struct
-import Network.TLS.Record.State
 import qualified Data.ByteString as B
-import Data.Byteable
-import Control.Applicative ((<$>))
 
+import Network.TLS.Imports
+import Network.TLS.Record.State
+import Network.TLS.Struct
+
 -- | Represent a TLS record.
-data Record a = Record !ProtocolType !Version !(Fragment a) deriving (Show,Eq)
+data Record a = Record ProtocolType Version (Fragment a) deriving (Show, Eq)
 
-newtype Fragment a = Fragment Bytes deriving (Show,Eq)
+newtype Fragment a = Fragment {fragmentGetBytes :: ByteString}
+    deriving (Show, Eq)
 
 data Plaintext
-data Compressed
 data Ciphertext
 
-fragmentPlaintext :: Bytes -> Fragment Plaintext
+fragmentPlaintext :: ByteString -> Fragment Plaintext
 fragmentPlaintext bytes = Fragment bytes
 
-fragmentCiphertext :: Bytes -> Fragment Ciphertext
+fragmentCiphertext :: ByteString -> Fragment Ciphertext
 fragmentCiphertext bytes = Fragment bytes
 
-instance Byteable (Fragment a) where
-    toBytes (Fragment b) = b
-
-onRecordFragment :: Record a -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
+onRecordFragment
+    :: Record a -> (Fragment a -> RecordM (Fragment b)) -> RecordM (Record b)
 onRecordFragment (Record pt ver frag) f = Record pt ver <$> f frag
 
-fragmentMap :: (Bytes -> RecordM Bytes) -> Fragment a -> RecordM (Fragment b)
+fragmentMap
+    :: (ByteString -> RecordM ByteString) -> Fragment a -> RecordM (Fragment b)
 fragmentMap f (Fragment b) = Fragment <$> f b
 
--- | turn a plaintext record into a compressed record using the compression function supplied
-fragmentCompress :: (Bytes -> RecordM Bytes) -> Fragment Plaintext -> RecordM (Fragment Compressed)
-fragmentCompress f = fragmentMap f
-
 -- | turn a compressed record into a ciphertext record using the cipher function supplied
-fragmentCipher :: (Bytes -> RecordM Bytes) -> Fragment Compressed -> RecordM (Fragment Ciphertext)
+fragmentCipher
+    :: (ByteString -> RecordM ByteString)
+    -> Fragment Plaintext
+    -> RecordM (Fragment Ciphertext)
 fragmentCipher f = fragmentMap f
 
--- | turn a ciphertext fragment into a compressed fragment using the cipher function supplied
-fragmentUncipher :: (Bytes -> RecordM Bytes) -> Fragment Ciphertext -> RecordM (Fragment Compressed)
+-- | turn a ciphertext fragment into a plaintext fragment using the cipher function supplied
+fragmentUncipher
+    :: (ByteString -> RecordM ByteString)
+    -> Fragment Ciphertext
+    -> RecordM (Fragment Plaintext)
 fragmentUncipher f = fragmentMap f
 
--- | turn a compressed fragment into a plaintext fragment using the decompression function supplied
-fragmentUncompress :: (Bytes -> RecordM Bytes) -> Fragment Compressed -> RecordM (Fragment Plaintext)
-fragmentUncompress f = fragmentMap f
-
 -- | turn a record into an header and bytes
-recordToRaw :: Record a -> (Header, Bytes)
+recordToRaw :: Record a -> (Header, ByteString)
 recordToRaw (Record pt ver (Fragment bytes)) = (Header pt ver (fromIntegral $ B.length bytes), bytes)
 
 -- | turn a header and a fragment into a record
diff --git a/Network/TLS/Sending.hs b/Network/TLS/Sending.hs
deleted file mode 100644
--- a/Network/TLS/Sending.hs
+++ /dev/null
@@ -1,90 +0,0 @@
--- |
--- Module      : Network.TLS.Sending
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- the Sending module contains calls related to marshalling packets according
--- to the TLS state 
---
-module Network.TLS.Sending (writePacket) where
-
-import Control.Applicative
-import Control.Monad.State
-import Control.Concurrent.MVar
-import Data.IORef
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-
-import Network.TLS.Types (Role(..))
-import Network.TLS.Cap
-import Network.TLS.Struct
-import Network.TLS.Record
-import Network.TLS.Packet
-import Network.TLS.Context.Internal
-import Network.TLS.Parameters
-import Network.TLS.State
-import Network.TLS.Handshake.State
-import Network.TLS.Cipher
-import Network.TLS.Util
-
--- | 'makePacketData' create a Header and a content bytestring related to a packet
--- this doesn't change any state
-makeRecord :: Packet -> RecordM (Record Plaintext)
-makeRecord pkt = do
-    ver <- getRecordVersion
-    return $ Record (packetType pkt) ver (fragmentPlaintext $ writePacketContent pkt)
-  where writePacketContent (Handshake hss)    = encodeHandshakes hss
-        writePacketContent (Alert a)          = encodeAlerts a
-        writePacketContent (ChangeCipherSpec) = encodeChangeCipherSpec
-        writePacketContent (AppData x)        = x
-
--- | marshall packet data
-encodeRecord :: Record Ciphertext -> RecordM ByteString
-encodeRecord record = return $ B.concat [ encodeHeader hdr, content ]
-  where (hdr, content) = recordToRaw record
-
--- | writePacket transform a packet into marshalled data related to current state
--- and updating state on the go
-writePacket :: Context -> Packet -> IO (Either TLSError ByteString)
-writePacket ctx pkt@(Handshake hss) = do
-    forM_ hss $ \hs -> do
-        case hs of
-            Finished fdata -> usingState_ ctx $ updateVerifiedData ClientRole fdata
-            _              -> return ()
-        let encoded = encodeHandshake hs
-        usingHState ctx $ do
-            when (certVerifyHandshakeMaterial hs) $ addHandshakeMessage encoded
-            when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ updateHandshakeDigest encoded
-    prepareRecord ctx (makeRecord pkt >>= engageRecord >>= encodeRecord)
-writePacket ctx pkt = do
-    d <- prepareRecord ctx (makeRecord pkt >>= engageRecord >>= encodeRecord)
-    when (pkt == ChangeCipherSpec) $ switchTxEncryption ctx
-    return d
-
--- before TLS 1.1, the block cipher IV is made of the residual of the previous block,
--- so we use cstIV as is, however in other case we generate an explicit IV
-prepareRecord :: Context -> RecordM a -> IO (Either TLSError a)
-prepareRecord ctx f = do
-    ver     <- usingState_ ctx (getVersionWithDefault $ maximum $ supportedVersions $ ctxSupported ctx)
-    txState <- readMVar $ ctxTxState ctx
-    let sz = case stCipher $ txState of
-                  Nothing     -> 0
-                  Just cipher -> bulkIVSize $ cipherBulk cipher
-    if hasExplicitBlockIV ver && sz > 0
-        then do newIV <- getStateRNG ctx sz
-                runTxState ctx (modify (setRecordIV newIV) >> f)
-        else runTxState ctx f
-
-switchTxEncryption :: Context -> IO ()
-switchTxEncryption ctx = do
-    tx  <- usingHState ctx (fromJust "tx-state" <$> gets hstPendingTxState)
-    (ver, cc) <- usingState_ ctx $ do v <- getVersion
-                                      c <- isClientContext
-                                      return (v, c)
-    liftIO $ modifyMVar_ (ctxTxState ctx) (\_ -> return tx)
-    -- set empty packet counter measure if condition are met
-    when (ver <= TLS10 && cc == ClientRole && isCBC tx) $ liftIO $ writeIORef (ctxNeedEmptyPacket ctx) True
-  where isCBC tx = maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stCipher tx)
diff --git a/Network/TLS/Session.hs b/Network/TLS/Session.hs
--- a/Network/TLS/Session.hs
+++ b/Network/TLS/Session.hs
@@ -1,30 +1,35 @@
--- |
--- Module      : Network.TLS.Session
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Session
-    ( SessionManager(..)
-    , noSessionManager
-    ) where
+module Network.TLS.Session (
+    SessionManager (..),
+    noSessionManager,
+) where
 
 import Network.TLS.Types
 
--- | A session manager
+-- | A session manager.
+-- In the server side, all fields are used.
+-- In the client side, only 'sessionEstablish' is used.
 data SessionManager = SessionManager
-    { -- | used on server side to decide whether to resume a client session.
-      sessionResume     :: SessionID -> IO (Maybe SessionData)
-      -- | used when a session is established.
-    , sessionEstablish  :: SessionID -> SessionData -> IO ()
-      -- | used when a session is invalidated.
-    , sessionInvalidate :: SessionID -> IO ()
+    { sessionResume :: SessionIDorTicket -> IO (Maybe SessionData)
+    -- ^ Used on TLS 1.2\/1.3 servers to lookup 'SessionData' with 'SessionID' or to decrypt 'Ticket' to get 'SessionData'.
+    , sessionResumeOnlyOnce :: SessionIDorTicket -> IO (Maybe SessionData)
+    -- ^ Used for 0RTT on TLS 1.3 servers to lookup 'SessionData' with 'SessionID' or to decrypt 'Ticket' to get 'SessionData'.
+    , sessionEstablish :: SessionIDorTicket -> SessionData -> IO (Maybe Ticket)
+    -- ^ Used on TLS 1.2\/1.3 servers to store 'SessionData' with 'SessionID' or to encrypt 'SessionData' to get 'Ticket' ignoring 'SessionID'. Used on TLS 1.2\/1.3 clients to store 'SessionData' with 'SessionIDorTicket' and then return 'Nothing'. For clients, only this field should be set with 'noSessionManager'.
+    , sessionInvalidate :: SessionIDorTicket -> IO ()
+    -- ^ Used TLS 1.2 servers to delete 'SessionData' with 'SessionID' on errors.
+    , sessionUseTicket :: Bool
+    -- ^ Used on TLS 1.2 servers to decide to use 'SessionID' or 'Ticket'. Note that 'SessionID' and 'Ticket' are integrated as identity in TLS 1.3.
     }
 
+-- | The session manager to do nothing.
 noSessionManager :: SessionManager
-noSessionManager = SessionManager
-    { sessionResume     = \_   -> return Nothing
-    , sessionEstablish  = \_ _ -> return ()
-    , sessionInvalidate = \_   -> return ()
-    }
+noSessionManager =
+    SessionManager
+        { sessionResume = \_ -> return Nothing
+        , sessionResumeOnlyOnce = \_ -> return Nothing
+        , sessionEstablish = \_ _ -> return Nothing
+        , sessionInvalidate = \_ -> return ()
+        , -- Don't send NewSessionTicket in TLS 1.2 by default.
+          -- Send NewSessionTicket with SessionID in TLS 1.3 by default.
+          sessionUseTicket = False
+        }
diff --git a/Network/TLS/State.hs b/Network/TLS/State.hs
--- a/Network/TLS/State.hs
+++ b/Network/TLS/State.hs
@@ -1,217 +1,374 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
--- |
--- Module      : Network.TLS.State
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- the State module contains calls related to state initialization/manipulation
--- which is use by the Receiving module and the Sending module.
---
-module Network.TLS.State
-    ( TLSState(..)
-    , TLSSt
-    , runTLSState
-    , newTLSState
-    , withTLSRNG
-    , updateVerifiedData
-    , finishHandshakeTypeMaterial
-    , finishHandshakeMaterial
-    , certVerifyHandshakeTypeMaterial
-    , certVerifyHandshakeMaterial
-    , setVersion
-    , setVersionIfUnset
-    , getVersion
-    , getVersionWithDefault
-    , setSecureRenegotiation
-    , getSecureRenegotiation
-    , setExtensionNPN
-    , getExtensionNPN
-    , setNegotiatedProtocol
-    , getNegotiatedProtocol
-    , setServerNextProtocolSuggest
-    , getServerNextProtocolSuggest
-    , getClientCertificateChain
-    , setClientCertificateChain
-    , getVerifiedData
-    , setSession
-    , getSession
-    , isSessionResuming
-    , isClientContext
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+
+-- | the State module contains calls related to state
+-- initialization/manipulation which is use by the Receiving module
+-- and the Sending module.
+module Network.TLS.State (
+    TLSState (..),
+    TLSSt,
+    runTLSState,
+    newTLSState,
+    withTLSRNG,
+    setVerifyDataForSend,
+    setVerifyDataForRecv,
+    getVerifyData,
+    getMyVerifyData,
+    getPeerVerifyData,
+    getFirstVerifyData,
+    finishedHandshakeTypeMaterial,
+    finishedHandshakeMaterial,
+    certVerifyHandshakeTypeMaterial,
+    certVerifyHandshakeMaterial,
+    setVersion,
+    setVersionIfUnset,
+    getVersion,
+    getVersionWithDefault,
+    setSecureRenegotiation,
+    getSecureRenegotiation,
+    setExtensionALPN,
+    getExtensionALPN,
+    setNegotiatedProtocol,
+    getNegotiatedProtocol,
+    setClientALPNSuggest,
+    getClientALPNSuggest,
+    setClientEcPointFormatSuggest,
+    getClientEcPointFormatSuggest,
+    setClientSNI,
+    clearClientSNI,
+    getClientSNI,
+    getClientCertificateChain,
+    setClientCertificateChain,
+    getServerCertificateChain,
+    setServerCertificateChain,
+    setSession,
+    getSession,
+    getRole,
+    --
+    setTLS12SessionResuming,
+    getTLS12SessionResuming,
+    --
+    setTLS13ExporterSecret,
+    getTLS13ExporterSecret,
+    setTLS13KeyShare,
+    getTLS13KeyShare,
+    setTLS13PreSharedKey,
+    getTLS13PreSharedKey,
+    setTLS13HRR,
+    getTLS13HRR,
+    setTLS13Cookie,
+    getTLS13Cookie,
+    setTLS13ClientSupportsPHA,
+    getTLS13ClientSupportsPHA,
+    setTLS12SessionTicket,
+    getTLS12SessionTicket,
+
     -- * random
-    , genRandom
-    , withRNG
-    ) where
+    genRandom,
+    withRNG,
+) where
 
-import Control.Applicative
-import Network.TLS.Struct
-import Network.TLS.RNG
-import Network.TLS.Types (Role(..))
-import Network.TLS.Wire (GetContinuation)
-import qualified Data.ByteString as B
-import Control.Monad.State
-import Control.Monad.Error
+import Control.Monad.State.Strict
 import Crypto.Random
 import Data.X509 (CertificateChain)
 
+import Network.TLS.ErrT
+import Network.TLS.Extension
+import Network.TLS.Imports
+import Network.TLS.RNG
+import Network.TLS.Struct
+import Network.TLS.Types (HostName, Role (..), Secret, Ticket, WireBytes)
+import Network.TLS.Wire (GetContinuation)
+
 data TLSState = TLSState
-    { stSession             :: Session
-    , stSessionResuming     :: Bool
-    , stSecureRenegotiation :: Bool  -- RFC 5746
-    , stClientVerifiedData  :: Bytes -- RFC 5746
-    , stServerVerifiedData  :: Bytes -- RFC 5746
-    , stExtensionNPN        :: Bool  -- NPN draft extension
-    , stHandshakeRecordCont :: Maybe (GetContinuation (HandshakeType, Bytes))
-    , stNegotiatedProtocol  :: Maybe B.ByteString -- NPN protocol
-    , stServerNextProtocolSuggest :: Maybe [B.ByteString]
+    { stSession :: Session
+    , -- RFC 5746, Renegotiation Indication Extension
+      -- RFC 5929, Channel Bindings for TLS, "tls-unique"
+      stSecureRenegotiation :: Bool
+    , stClientVerifyData :: Maybe VerifyData
+    , stServerVerifyData :: Maybe VerifyData
+    , -- RFC 5929, Channel Bindings for TLS, "tls-server-end-point"
+      stServerCertificateChain :: Maybe CertificateChain
+    , stExtensionALPN :: Bool -- RFC 7301
+    , stNegotiatedProtocol :: Maybe ByteString -- ALPN protocol
+    , stHandshakeRecordCont12
+        :: (Maybe (GetContinuation (HandshakeType, ByteString)), WireBytes)
+    , stHandshakeRecordCont13
+        :: (Maybe (GetContinuation (HandshakeType, ByteString)), WireBytes)
+    , stClientALPNSuggest :: Maybe [ByteString]
+    , stClientGroupSuggest :: Maybe [Group]
+    , stClientEcPointFormatSuggest :: Maybe [EcPointFormat]
     , stClientCertificateChain :: Maybe CertificateChain
-    , stRandomGen           :: StateRNG
-    , stVersion             :: Maybe Version
-    , stClientContext       :: Role
+    , stClientSNI :: Maybe HostName
+    , stRandomGen :: StateRNG
+    , stClientContext :: Role
+    , stVersion :: Maybe Version
+    , --
+      stTLS12SessionResuming :: Bool
+    , stTLS12SessionTicket :: Maybe Ticket
+    , --
+      stTLS13KeyShare :: Maybe KeyShare
+    , stTLS13PreSharedKey :: Maybe PreSharedKey
+    , stTLS13HRR :: Bool
+    , stTLS13Cookie :: Maybe Cookie
+    , stTLS13ExporterSecret :: Maybe Secret
+    , stTLS13ClientSupportsPHA :: Bool -- Post-Handshake Authentication
     }
 
-newtype TLSSt a = TLSSt { runTLSSt :: ErrorT TLSError (State TLSState) a }
+newtype TLSSt a = TLSSt {runTLSSt :: ErrT TLSError (State TLSState) a}
     deriving (Monad, MonadError TLSError, Functor, Applicative)
 
 instance MonadState TLSState TLSSt where
     put x = TLSSt (lift $ put x)
-    get   = TLSSt (lift get)
-#if MIN_VERSION_mtl(2,1,0)
+    get = TLSSt (lift get)
     state f = TLSSt (lift $ state f)
-#endif
 
 runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
-runTLSState f st = runState (runErrorT (runTLSSt f)) st
+runTLSState f st = runState (runErrT (runTLSSt f)) st
 
-newTLSState :: CPRG g => g -> Role -> TLSState
-newTLSState rng clientContext = TLSState
-    { stSession             = Session Nothing
-    , stSessionResuming     = False
-    , stSecureRenegotiation = False
-    , stClientVerifiedData  = B.empty
-    , stServerVerifiedData  = B.empty
-    , stExtensionNPN        = False
-    , stHandshakeRecordCont = Nothing
-    , stNegotiatedProtocol  = Nothing
-    , stServerNextProtocolSuggest = Nothing
-    , stClientCertificateChain = Nothing
-    , stRandomGen           = StateRNG rng
-    , stVersion             = Nothing
-    , stClientContext       = clientContext
-    }
+newTLSState :: StateRNG -> Role -> TLSState
+newTLSState rng clientContext =
+    TLSState
+        { stSession = Session Nothing
+        , stSecureRenegotiation = False
+        , stClientVerifyData = Nothing
+        , stServerVerifyData = Nothing
+        , stServerCertificateChain = Nothing
+        , stExtensionALPN = False
+        , stNegotiatedProtocol = Nothing
+        , stHandshakeRecordCont12 = (Nothing, [])
+        , stHandshakeRecordCont13 = (Nothing, [])
+        , stClientALPNSuggest = Nothing
+        , stClientGroupSuggest = Nothing
+        , stClientEcPointFormatSuggest = Nothing
+        , stClientCertificateChain = Nothing
+        , stClientSNI = Nothing
+        , stRandomGen = rng
+        , stClientContext = clientContext
+        , stVersion = Nothing
+        , stTLS12SessionResuming = False
+        , stTLS12SessionTicket = Nothing
+        , stTLS13KeyShare = Nothing
+        , stTLS13PreSharedKey = Nothing
+        , stTLS13HRR = False
+        , stTLS13Cookie = Nothing
+        , stTLS13ExporterSecret = Nothing
+        , stTLS13ClientSupportsPHA = False
+        }
 
-updateVerifiedData :: Role -> Bytes -> TLSSt ()
-updateVerifiedData sending bs = do
-    cc <- isClientContext
-    if cc /= sending
-        then modify (\st -> st { stServerVerifiedData = bs })
-        else modify (\st -> st { stClientVerifiedData = bs })
+setVerifyDataForSend :: VerifyData -> TLSSt ()
+setVerifyDataForSend bs = do
+    role <- getRole
+    case role of
+        ClientRole -> modify' (\st -> st{stClientVerifyData = Just bs})
+        ServerRole -> modify' (\st -> st{stServerVerifyData = Just bs})
 
-finishHandshakeTypeMaterial :: HandshakeType -> Bool
-finishHandshakeTypeMaterial HandshakeType_ClientHello     = True
-finishHandshakeTypeMaterial HandshakeType_ServerHello     = True
-finishHandshakeTypeMaterial HandshakeType_Certificate     = True
-finishHandshakeTypeMaterial HandshakeType_HelloRequest    = False
-finishHandshakeTypeMaterial HandshakeType_ServerHelloDone = True
-finishHandshakeTypeMaterial HandshakeType_ClientKeyXchg   = True
-finishHandshakeTypeMaterial HandshakeType_ServerKeyXchg   = True
-finishHandshakeTypeMaterial HandshakeType_CertRequest     = True
-finishHandshakeTypeMaterial HandshakeType_CertVerify      = True
-finishHandshakeTypeMaterial HandshakeType_Finished        = True
-finishHandshakeTypeMaterial HandshakeType_NPN             = True
+setVerifyDataForRecv :: VerifyData -> TLSSt ()
+setVerifyDataForRecv bs = do
+    role <- getRole
+    case role of
+        ClientRole -> modify' (\st -> st{stServerVerifyData = Just bs})
+        ServerRole -> modify' (\st -> st{stClientVerifyData = Just bs})
 
-finishHandshakeMaterial :: Handshake -> Bool
-finishHandshakeMaterial = finishHandshakeTypeMaterial . typeOfHandshake
+finishedHandshakeTypeMaterial :: HandshakeType -> Bool
+finishedHandshakeTypeMaterial HandshakeType_ClientHello = True
+finishedHandshakeTypeMaterial HandshakeType_ServerHello = True
+finishedHandshakeTypeMaterial HandshakeType_Certificate = True
+-- finishedHandshakeTypeMaterial HandshakeType_HelloRequest = False
+finishedHandshakeTypeMaterial HandshakeType_ServerHelloDone = True
+finishedHandshakeTypeMaterial HandshakeType_ClientKeyXchg = True
+finishedHandshakeTypeMaterial HandshakeType_ServerKeyXchg = True
+finishedHandshakeTypeMaterial HandshakeType_CertRequest = True
+finishedHandshakeTypeMaterial HandshakeType_CertVerify = True
+finishedHandshakeTypeMaterial HandshakeType_NewSessionTicket = True
+finishedHandshakeTypeMaterial HandshakeType_Finished = True
+finishedHandshakeTypeMaterial _ = False
 
+finishedHandshakeMaterial :: Handshake -> Bool
+finishedHandshakeMaterial = finishedHandshakeTypeMaterial . typeOfHandshake
+
 certVerifyHandshakeTypeMaterial :: HandshakeType -> Bool
-certVerifyHandshakeTypeMaterial HandshakeType_ClientHello     = True
-certVerifyHandshakeTypeMaterial HandshakeType_ServerHello     = True
-certVerifyHandshakeTypeMaterial HandshakeType_Certificate     = True
-certVerifyHandshakeTypeMaterial HandshakeType_HelloRequest    = False
+certVerifyHandshakeTypeMaterial HandshakeType_ClientHello = True
+certVerifyHandshakeTypeMaterial HandshakeType_ServerHello = True
+certVerifyHandshakeTypeMaterial HandshakeType_Certificate = True
+-- certVerifyHandshakeTypeMaterial HandshakeType_HelloRequest = False
 certVerifyHandshakeTypeMaterial HandshakeType_ServerHelloDone = True
-certVerifyHandshakeTypeMaterial HandshakeType_ClientKeyXchg   = True
-certVerifyHandshakeTypeMaterial HandshakeType_ServerKeyXchg   = True
-certVerifyHandshakeTypeMaterial HandshakeType_CertRequest     = True
-certVerifyHandshakeTypeMaterial HandshakeType_CertVerify      = False
-certVerifyHandshakeTypeMaterial HandshakeType_Finished        = False
-certVerifyHandshakeTypeMaterial HandshakeType_NPN             = False
+certVerifyHandshakeTypeMaterial HandshakeType_ClientKeyXchg = True
+certVerifyHandshakeTypeMaterial HandshakeType_ServerKeyXchg = True
+certVerifyHandshakeTypeMaterial HandshakeType_CertRequest = True
+-- certVerifyHandshakeTypeMaterial HandshakeType_CertVerify = False
+-- certVerifyHandshakeTypeMaterial HandshakeType_Finished = False
+certVerifyHandshakeTypeMaterial _ = False
 
 certVerifyHandshakeMaterial :: Handshake -> Bool
 certVerifyHandshakeMaterial = certVerifyHandshakeTypeMaterial . typeOfHandshake
 
-setSession :: Session -> Bool -> TLSSt ()
-setSession session resuming = modify (\st -> st { stSession = session, stSessionResuming = resuming })
+setSession :: Session -> TLSSt ()
+setSession session = modify' (\st -> st{stSession = session})
 
 getSession :: TLSSt Session
 getSession = gets stSession
 
-isSessionResuming :: TLSSt Bool
-isSessionResuming = gets stSessionResuming
+setTLS12SessionResuming :: Bool -> TLSSt ()
+setTLS12SessionResuming b = modify' (\st -> st{stTLS12SessionResuming = b})
 
+getTLS12SessionResuming :: TLSSt Bool
+getTLS12SessionResuming = gets stTLS12SessionResuming
+
 setVersion :: Version -> TLSSt ()
-setVersion ver = modify (\st -> st { stVersion = Just ver })
+setVersion ver = modify' (\st -> st{stVersion = Just ver})
 
 setVersionIfUnset :: Version -> TLSSt ()
-setVersionIfUnset ver = modify maybeSet
-  where maybeSet st = case stVersion st of
-                           Nothing -> st { stVersion = Just ver }
-                           Just _  -> st
+setVersionIfUnset ver = modify' maybeSet
+  where
+    maybeSet st = case stVersion st of
+        Nothing -> st{stVersion = Just ver}
+        Just _ -> st
 
 getVersion :: TLSSt Version
-getVersion = maybe (error $ "internal error: version hasn't been set yet") id <$> gets stVersion
+getVersion =
+    fromMaybe (error "internal error: version hasn't been set yet")
+        <$> gets stVersion
 
 getVersionWithDefault :: Version -> TLSSt Version
-getVersionWithDefault defaultVer = maybe defaultVer id <$> gets stVersion
+getVersionWithDefault defaultVer = fromMaybe defaultVer <$> gets stVersion
 
 setSecureRenegotiation :: Bool -> TLSSt ()
-setSecureRenegotiation b = modify (\st -> st { stSecureRenegotiation = b })
+setSecureRenegotiation b = modify' (\st -> st{stSecureRenegotiation = b})
 
 getSecureRenegotiation :: TLSSt Bool
 getSecureRenegotiation = gets stSecureRenegotiation
 
-setExtensionNPN :: Bool -> TLSSt ()
-setExtensionNPN b = modify (\st -> st { stExtensionNPN = b })
+setExtensionALPN :: Bool -> TLSSt ()
+setExtensionALPN b = modify' (\st -> st{stExtensionALPN = b})
 
-getExtensionNPN :: TLSSt Bool
-getExtensionNPN = gets stExtensionNPN
+getExtensionALPN :: TLSSt Bool
+getExtensionALPN = gets stExtensionALPN
 
-setNegotiatedProtocol :: B.ByteString -> TLSSt ()
-setNegotiatedProtocol s = modify (\st -> st { stNegotiatedProtocol = Just s })
+setNegotiatedProtocol :: ByteString -> TLSSt ()
+setNegotiatedProtocol s = modify' (\st -> st{stNegotiatedProtocol = Just s})
 
-getNegotiatedProtocol :: TLSSt (Maybe B.ByteString)
+getNegotiatedProtocol :: TLSSt (Maybe ByteString)
 getNegotiatedProtocol = gets stNegotiatedProtocol
 
-setServerNextProtocolSuggest :: [B.ByteString] -> TLSSt ()
-setServerNextProtocolSuggest ps = modify (\st -> st { stServerNextProtocolSuggest = Just ps})
+setClientALPNSuggest :: [ByteString] -> TLSSt ()
+setClientALPNSuggest ps = modify' (\st -> st{stClientALPNSuggest = Just ps})
 
-getServerNextProtocolSuggest :: TLSSt (Maybe [B.ByteString])
-getServerNextProtocolSuggest = gets stServerNextProtocolSuggest
+getClientALPNSuggest :: TLSSt (Maybe [ByteString])
+getClientALPNSuggest = gets stClientALPNSuggest
 
+setClientEcPointFormatSuggest :: [EcPointFormat] -> TLSSt ()
+setClientEcPointFormatSuggest epf = modify' (\st -> st{stClientEcPointFormatSuggest = Just epf})
+
+getClientEcPointFormatSuggest :: TLSSt (Maybe [EcPointFormat])
+getClientEcPointFormatSuggest = gets stClientEcPointFormatSuggest
+
 setClientCertificateChain :: CertificateChain -> TLSSt ()
-setClientCertificateChain s = modify (\st -> st { stClientCertificateChain = Just s })
+setClientCertificateChain s = modify' (\st -> st{stClientCertificateChain = Just s})
 
 getClientCertificateChain :: TLSSt (Maybe CertificateChain)
 getClientCertificateChain = gets stClientCertificateChain
 
-getVerifiedData :: Role -> TLSSt Bytes
-getVerifiedData client = gets (if client == ClientRole then stClientVerifiedData else stServerVerifiedData)
+setServerCertificateChain :: CertificateChain -> TLSSt ()
+setServerCertificateChain s = modify' (\st -> st{stServerCertificateChain = Just s})
 
-isClientContext :: TLSSt Role
-isClientContext = gets stClientContext
+getServerCertificateChain :: TLSSt (Maybe CertificateChain)
+getServerCertificateChain = gets stServerCertificateChain
 
-genRandom :: Int -> TLSSt Bytes
+setClientSNI :: HostName -> TLSSt ()
+setClientSNI hn = modify' (\st -> st{stClientSNI = Just hn})
+
+clearClientSNI :: TLSSt ()
+clearClientSNI = modify' (\st -> st{stClientSNI = Nothing})
+
+getClientSNI :: TLSSt (Maybe HostName)
+getClientSNI = gets stClientSNI
+
+getVerifyData :: Role -> TLSSt VerifyData
+getVerifyData client = do
+    mVerifyData <-
+        gets (if client == ClientRole then stClientVerifyData else stServerVerifyData)
+    return $ fromMaybe (VerifyData "") mVerifyData
+
+getMyVerifyData :: TLSSt (Maybe VerifyData)
+getMyVerifyData = do
+    role <- getRole
+    if role == ClientRole
+        then gets stClientVerifyData
+        else gets stServerVerifyData
+
+getPeerVerifyData :: TLSSt (Maybe VerifyData)
+getPeerVerifyData = do
+    role <- getRole
+    if role == ClientRole
+        then gets stServerVerifyData
+        else gets stClientVerifyData
+
+getFirstVerifyData :: TLSSt (Maybe VerifyData)
+getFirstVerifyData = do
+    ver <- getVersion
+    case ver of
+        TLS13 -> gets stServerVerifyData
+        _ -> do
+            resuming <- getTLS12SessionResuming
+            if resuming
+                then gets stServerVerifyData
+                else gets stClientVerifyData
+
+getRole :: TLSSt Role
+getRole = gets stClientContext
+
+genRandom :: Int -> TLSSt ByteString
 genRandom n = do
-    st <- get
-    case withTLSRNG (stRandomGen st) (cprgGenerate n) of
-            (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
+    withRNG (getRandomBytes n)
 
-withRNG :: (forall g . CPRG g => g -> (a, g)) -> TLSSt a
+withRNG :: MonadPseudoRandom StateRNG a -> TLSSt a
 withRNG f = do
     st <- get
-    let (a,rng') = withTLSRNG (stRandomGen st) f
-    put (st { stRandomGen = rng' })
+    let (a, rng') = withTLSRNG (stRandomGen st) f
+    put (st{stRandomGen = rng'})
     return a
+
+setTLS12SessionTicket :: Ticket -> TLSSt ()
+setTLS12SessionTicket t = modify' (\st -> st{stTLS12SessionTicket = Just t})
+
+getTLS12SessionTicket :: TLSSt (Maybe Ticket)
+getTLS12SessionTicket = gets stTLS12SessionTicket
+
+setTLS13ExporterSecret :: Secret -> TLSSt ()
+setTLS13ExporterSecret key = modify' (\st -> st{stTLS13ExporterSecret = Just key})
+
+getTLS13ExporterSecret :: TLSSt (Maybe Secret)
+getTLS13ExporterSecret = gets stTLS13ExporterSecret
+
+setTLS13KeyShare :: Maybe KeyShare -> TLSSt ()
+setTLS13KeyShare mks = modify' (\st -> st{stTLS13KeyShare = mks})
+
+getTLS13KeyShare :: TLSSt (Maybe KeyShare)
+getTLS13KeyShare = gets stTLS13KeyShare
+
+setTLS13PreSharedKey :: Maybe PreSharedKey -> TLSSt ()
+setTLS13PreSharedKey mpsk = modify' (\st -> st{stTLS13PreSharedKey = mpsk})
+
+getTLS13PreSharedKey :: TLSSt (Maybe PreSharedKey)
+getTLS13PreSharedKey = gets stTLS13PreSharedKey
+
+setTLS13HRR :: Bool -> TLSSt ()
+setTLS13HRR b = modify' (\st -> st{stTLS13HRR = b})
+
+getTLS13HRR :: TLSSt Bool
+getTLS13HRR = gets stTLS13HRR
+
+setTLS13Cookie :: Maybe Cookie -> TLSSt ()
+setTLS13Cookie mcookie = modify' (\st -> st{stTLS13Cookie = mcookie})
+
+getTLS13Cookie :: TLSSt (Maybe Cookie)
+getTLS13Cookie = gets stTLS13Cookie
+
+setTLS13ClientSupportsPHA :: Bool -> TLSSt ()
+setTLS13ClientSupportsPHA b = modify' (\st -> st{stTLS13ClientSupportsPHA = b})
+
+getTLS13ClientSupportsPHA :: TLSSt Bool
+getTLS13ClientSupportsPHA = gets stTLS13ClientSupportsPHA
diff --git a/Network/TLS/Struct.hs b/Network/TLS/Struct.hs
--- a/Network/TLS/Struct.hs
+++ b/Network/TLS/Struct.hs
@@ -1,478 +1,501 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# OPTIONS_HADDOCK hide #-}
-{-# LANGUAGE DeriveDataTypeable #-}
--- |
--- Module      : Network.TLS.Struct
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- the Struct module contains all definitions and values of the TLS protocol
---
-module Network.TLS.Struct
-    ( Bytes
-    , Version(..)
-    , ConnectionEnd(..)
-    , CipherType(..)
-    , CipherData(..)
-    , ExtensionID
-    , ExtensionRaw
-    , CertificateType(..)
-    , HashAlgorithm(..)
-    , SignatureAlgorithm(..)
-    , HashAndSignatureAlgorithm
-    , DigitallySigned(..)
-    , ProtocolType(..)
-    , TLSError(..)
-    , TLSException(..)
-    , DistinguishedName
-    , ServerDHParams(..)
-    , ServerRSAParams(..)
-    , ServerKeyXchgAlgorithmData(..)
-    , ClientKeyXchgAlgorithmData(..)
-    , Packet(..)
-    , Header(..)
-    , ServerRandom(..)
-    , ClientRandom(..)
-    , serverRandom
-    , clientRandom
-    , FinishedData
-    , SessionID
-    , Session(..)
-    , SessionData(..)
-    , AlertLevel(..)
-    , AlertDescription(..)
-    , HandshakeType(..)
-    , Handshake(..)
-    , numericalVer
-    , verOfNum
-    , TypeValuable, valOfType, valToType
-    , packetType
-    , typeOfHandshake
-    ) where
 
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B (length)
-import Data.Word
-import Data.X509 (CertificateChain, DistinguishedName)
-import Data.Typeable
-import Control.Monad.Error (Error(..))
-import Control.Exception (Exception(..))
-import Network.TLS.Types
-import Network.TLS.Crypto.DH
+-- | The Struct module contains all definitions and values of the TLS
+-- protocol.
+module Network.TLS.Struct (
+    Version (..),
+    CipherData (..),
+    CertificateType (
+        CertificateType,
+        CertificateType_RSA_Sign,
+        CertificateType_DSA_Sign,
+        CertificateType_ECDSA_Sign,
+        CertificateType_Ed25519_Sign,
+        CertificateType_Ed448_Sign
+    ),
+    fromCertificateType,
+    lastSupportedCertificateType,
+    DigitallySigned (..),
+    Signature,
+    ProtocolType (
+        ..,
+        ProtocolType_ChangeCipherSpec,
+        ProtocolType_Alert,
+        ProtocolType_Handshake,
+        ProtocolType_AppData
+    ),
+    TLSError (..),
+    TLSException (..),
+    DistinguishedName,
+    ServerDHParams (..),
+    serverDHParamsToParams,
+    serverDHParamsToPublic,
+    serverDHParamsFrom,
+    ServerECDHParams (..),
+    ServerRSAParams (..),
+    ServerKeyXchgAlgorithmData (..),
+    ClientKeyXchgAlgorithmData (..),
+    Packet (..),
+    Header (..),
+    ServerRandom (..),
+    ClientRandom (..),
+    FinishedData,
+    VerifyData (..),
+    SessionID,
+    Session (..),
+    SessionData (..),
+    AlertLevel (
+        ..,
+        AlertLevel_Warning,
+        AlertLevel_Fatal
+    ),
+    AlertDescription (
+        ..,
+        CloseNotify,
+        UnexpectedMessage,
+        BadRecordMac,
+        DecryptionFailed,
+        RecordOverflow,
+        DecompressionFailure,
+        HandshakeFailure,
+        BadCertificate,
+        UnsupportedCertificate,
+        CertificateRevoked,
+        CertificateExpired,
+        CertificateUnknown,
+        IllegalParameter,
+        UnknownCa,
+        AccessDenied,
+        DecodeError,
+        DecryptError,
+        ExportRestriction,
+        ProtocolVersion,
+        InsufficientSecurity,
+        InternalError,
+        InappropriateFallback,
+        UserCanceled,
+        NoRenegotiation,
+        MissingExtension,
+        UnsupportedExtension,
+        CertificateUnobtainable,
+        UnrecognizedName,
+        BadCertificateStatusResponse,
+        BadCertificateHashValue,
+        UnknownPskIdentity,
+        CertificateRequired,
+        NoApplicationProtocol
+    ),
+    HandshakeType (
+        ..,
+        HandshakeType_HelloRequest,
+        HandshakeType_ClientHello,
+        HandshakeType_ServerHello,
+        HandshakeType_NewSessionTicket,
+        HandshakeType_EndOfEarlyData,
+        HandshakeType_EncryptedExtensions,
+        HandshakeType_Certificate,
+        HandshakeType_ServerKeyXchg,
+        HandshakeType_CertRequest,
+        HandshakeType_ServerHelloDone,
+        HandshakeType_CertVerify,
+        HandshakeType_ClientKeyXchg,
+        HandshakeType_Finished,
+        HandshakeType_KeyUpdate,
+        HandshakeType_CompressedCertificate
+    ),
+    CertificateChain_ (..),
+    emptyCertificateChain_,
+    Handshake (..),
+    packetType,
+    typeOfHandshake,
+    module Network.TLS.HashAndSignature,
+    ExtensionRaw (..),
+    ExtensionID (..),
+    showCertificateChain,
+    isHelloRetryRequest,
+    hrrRandom,
+    ClientHello (..),
+    ServerHello (..),
+    HandshakeR,
+) where
 
-type Bytes = ByteString
+import Data.X509 (
+    CertificateChain (..),
+    DistinguishedName,
+    certSubjectDN,
+    getCharacterStringRawData,
+    getDistinguishedElements,
+    getSigned,
+    signedObject,
+ )
 
-data ConnectionEnd = ConnectionServer | ConnectionClient
-data CipherType = CipherStream | CipherBlock | CipherAEAD
+import Network.TLS.Crypto
+import Network.TLS.Error
+import {-# SOURCE #-} Network.TLS.Extension
+import Network.TLS.HashAndSignature
+import Network.TLS.Imports
+import Network.TLS.Types
 
+----------------------------------------------------------------
+
 data CipherData = CipherData
-    { cipherDataContent :: Bytes
-    , cipherDataMAC     :: Maybe Bytes
-    , cipherDataPadding :: Maybe Bytes
-    } deriving (Show,Eq)
+    { cipherDataContent :: ByteString
+    , cipherDataMAC :: Maybe ByteString
+    , cipherDataPadding :: Maybe (ByteString, Int)
+    }
+    deriving (Show, Eq)
 
-data CertificateType =
-      CertificateType_RSA_Sign         -- TLS10
-    | CertificateType_DSS_Sign         -- TLS10
-    | CertificateType_RSA_Fixed_DH     -- TLS10
-    | CertificateType_DSS_Fixed_DH     -- TLS10
-    | CertificateType_RSA_Ephemeral_DH -- TLS12
-    | CertificateType_DSS_Ephemeral_DH -- TLS12
-    | CertificateType_fortezza_dms     -- TLS12
-    | CertificateType_Unknown Word8
-    deriving (Show,Eq)
+----------------------------------------------------------------
 
-data HashAlgorithm =
-      HashNone
-    | HashMD5
-    | HashSHA1
-    | HashSHA224
-    | HashSHA256
-    | HashSHA384
-    | HashSHA512
-    | HashOther Word8
-    deriving (Show,Eq)
+-- | Some of the IANA registered code points for 'CertificateType' are not
+-- currently supported by the library.  Nor should they be, they're are either
+-- unwise, obsolete or both.  There's no point in conveying these to the user
+-- in the client certificate request callback.  The request callback will be
+-- filtered to exclude unsupported values.  If the user cannot find a certificate
+-- for a supported code point, we'll go ahead without a client certificate and
+-- hope for the best, unless the user's callback decides to throw an exception.
+newtype CertificateType = CertificateType {fromCertificateType :: Word8}
+    deriving (Eq, Ord)
 
-data SignatureAlgorithm =
-      SignatureAnonymous
-    | SignatureRSA
-    | SignatureDSS
-    | SignatureECDSA
-    | SignatureOther Word8
-    deriving (Show,Eq)
+{- FOURMOLU_DISABLE -}
+-- | TLS10 and up, RFC5246
+pattern CertificateType_RSA_Sign     :: CertificateType
+pattern CertificateType_RSA_Sign      = CertificateType 1
+-- | TLS10 and up, RFC5246
+pattern CertificateType_DSA_Sign     :: CertificateType
+pattern CertificateType_DSA_Sign      = CertificateType 2
+-- | TLS10 and up, RFC8422
+pattern CertificateType_ECDSA_Sign   :: CertificateType
+pattern CertificateType_ECDSA_Sign    = CertificateType 64
+-- \| There are no code points that map to the below synthetic types, these
+-- are inferred indirectly from the @signature_algorithms@ extension of the
+-- TLS 1.3 @CertificateRequest@ message.  the value assignments are there
+-- only to avoid partial function warnings.
+pattern CertificateType_Ed25519_Sign :: CertificateType
+pattern CertificateType_Ed25519_Sign  = CertificateType 254 -- fixme: dummy value
+pattern CertificateType_Ed448_Sign   :: CertificateType
+pattern CertificateType_Ed448_Sign    = CertificateType 255 -- fixme:  dummy value
 
-type HashAndSignatureAlgorithm = (HashAlgorithm, SignatureAlgorithm)
+instance Show CertificateType where
+    show CertificateType_RSA_Sign     = "rsa_sign"
+    show CertificateType_DSA_Sign     = "dss_sign"
+    show CertificateType_ECDSA_Sign   = "ecdsa_sign"
+    show CertificateType_Ed25519_Sign = "ed25519_sign"
+    show CertificateType_Ed448_Sign   = "ed448_sign"
+    show (CertificateType x)          = "CertificateType " ++ show x
+{- FOURMOLU_ENABLE -}
 
-type Signature = Bytes
+-- | Last supported certificate type, no 'CertificateType that
+-- compares greater than this one (based on the 'Ord' instance,
+-- not on the wire code point) will be reported to the application
+-- via the client certificate request callback.
+lastSupportedCertificateType :: CertificateType
+lastSupportedCertificateType = CertificateType_ECDSA_Sign
 
-data DigitallySigned = DigitallySigned (Maybe HashAndSignatureAlgorithm) Signature
-    deriving (Show,Eq)
+------------------------------------------------------------
 
-data ProtocolType =
-      ProtocolType_ChangeCipherSpec
-    | ProtocolType_Alert
-    | ProtocolType_Handshake
-    | ProtocolType_AppData
-    | ProtocolType_DeprecatedHandshake
-    deriving (Eq, Show)
+type Signature = ByteString
 
--- | TLSError that might be returned through the TLS stack
-data TLSError =
-      Error_Misc String        -- ^ mainly for instance of Error
-    | Error_Protocol (String, Bool, AlertDescription)
-    | Error_Certificate String
-    | Error_HandshakePolicy String -- ^ handshake policy failed.
-    | Error_EOF
-    | Error_Packet String
-    | Error_Packet_unexpected String String
-    | Error_Packet_Parsing String
-    deriving (Eq, Show, Typeable)
+data DigitallySigned = DigitallySigned HashAndSignatureAlgorithm Signature
+    deriving (Eq)
 
-instance Error TLSError where
-    noMsg  = Error_Misc ""
-    strMsg = Error_Misc
+instance Show DigitallySigned where
+    show (DigitallySigned hs _sig) = "DigitallySigned " ++ show hs ++ " \"...\""
 
-instance Exception TLSError
+----------------------------------------------------------------
 
--- | TLS Exceptions related to bad user usage or
--- asynchronous errors
-data TLSException =
-      Terminated Bool String TLSError -- ^ Early termination exception with the reason
-                                      --   and the error associated
-    | HandshakeFailed TLSError        -- ^ Handshake failed for the reason attached
-    | ConnectionNotEstablished        -- ^ Usage error when the connection has not been established
-                                      --   and the user is trying to send or receive data
-    deriving (Show,Eq,Typeable)
+newtype ProtocolType = ProtocolType {fromProtocolType :: Word8} deriving (Eq)
 
-instance Exception TLSException
+{- FOURMOLU_DISABLE -}
+pattern ProtocolType_ChangeCipherSpec :: ProtocolType
+pattern ProtocolType_ChangeCipherSpec  = ProtocolType 20
 
-data Packet =
-      Handshake [Handshake]
+pattern ProtocolType_Alert            :: ProtocolType
+pattern ProtocolType_Alert             = ProtocolType 21
+
+pattern ProtocolType_Handshake        :: ProtocolType
+pattern ProtocolType_Handshake         = ProtocolType 22
+
+pattern ProtocolType_AppData          :: ProtocolType
+pattern ProtocolType_AppData           = ProtocolType 23
+
+instance Show ProtocolType where
+    show ProtocolType_ChangeCipherSpec = "ChangeCipherSpec"
+    show ProtocolType_Alert            = "Alert"
+    show ProtocolType_Handshake        = "Handshake"
+    show ProtocolType_AppData          = "AppData"
+    show (ProtocolType x)              = "ProtocolType " ++ show x
+{- FOURMOLU_ENABLE -}
+
+----------------------------------------------------------------
+
+data Packet
+    = Handshake [Handshake] [WireBytes]
     | Alert [(AlertLevel, AlertDescription)]
     | ChangeCipherSpec
     | AppData ByteString
-    deriving (Show,Eq)
+    deriving (Eq)
 
-data Header = Header ProtocolType Version Word16 deriving (Show,Eq)
+instance Show Packet where
+    show (Handshake hs _) = "Handshake " ++ show hs
+    show (Alert as) = "Alert " ++ show as
+    show ChangeCipherSpec = "ChangeCipherSpec"
+    show (AppData bs) = "AppData " ++ showBytesHex bs
 
-newtype ServerRandom = ServerRandom Bytes deriving (Show, Eq)
-newtype ClientRandom = ClientRandom Bytes deriving (Show, Eq)
-newtype Session = Session (Maybe SessionID) deriving (Show, Eq)
+data Header = Header ProtocolType Version Word16 deriving (Show, Eq)
 
-type FinishedData = Bytes
-type ExtensionID  = Word16
-type ExtensionRaw = (ExtensionID, Bytes)
+newtype ServerRandom = ServerRandom {unServerRandom :: ByteString}
+    deriving (Eq)
+instance Show ServerRandom where
+    show sr@(ServerRandom bs)
+        | isHelloRetryRequest sr = "HelloRetryReqest"
+        | otherwise = "ServerRandom " ++ showBytesHex bs
 
-constrRandom32 :: (Bytes -> a) -> Bytes -> Maybe a
-constrRandom32 constr l = if B.length l == 32 then Just (constr l) else Nothing
+hrrRandom :: ServerRandom
+hrrRandom =
+    ServerRandom
+        "\xCF\x21\xAD\x74\xE5\x9A\x61\x11\xBE\x1D\x8C\x02\x1E\x65\xB8\x91\xC2\xA2\x11\x16\x7A\xBB\x8C\x5E\x07\x9E\x09\xE2\xC8\xA8\x33\x9C"
 
-serverRandom :: Bytes -> Maybe ServerRandom
-serverRandom l = constrRandom32 ServerRandom l
+isHelloRetryRequest :: ServerRandom -> Bool
+isHelloRetryRequest = (== hrrRandom)
 
-clientRandom :: Bytes -> Maybe ClientRandom
-clientRandom l = constrRandom32 ClientRandom l
+newtype ClientRandom = ClientRandom {unClientRandom :: ByteString}
+    deriving (Eq)
 
-data AlertLevel =
-      AlertLevel_Warning
-    | AlertLevel_Fatal
-    deriving (Show,Eq)
+instance Show ClientRandom where
+    show (ClientRandom bs) = "ClientRandom " ++ showBytesHex bs
 
-data AlertDescription =
-      CloseNotify
-    | UnexpectedMessage
-    | BadRecordMac
-    | DecryptionFailed       -- ^ deprecated alert, should never be sent by compliant implementation
-    | RecordOverflow
-    | DecompressionFailure
-    | HandshakeFailure
-    | BadCertificate
-    | UnsupportedCertificate
-    | CertificateRevoked
-    | CertificateExpired
-    | CertificateUnknown
-    | IllegalParameter
-    | UnknownCa
-    | AccessDenied
-    | DecodeError
-    | DecryptError
-    | ExportRestriction
-    | ProtocolVersion
-    | InsufficientSecurity
-    | InternalError
-    | UserCanceled
-    | NoRenegotiation
-    | UnsupportedExtension
-    | CertificateUnobtainable
-    | UnrecognizedName
-    | BadCertificateStatusResponse
-    | BadCertificateHashValue
-    deriving (Show,Eq)
+newtype Session = Session (Maybe SessionID) deriving (Eq)
+instance Show Session where
+    show (Session Nothing) = "Session \"\""
+    show (Session (Just bs)) = "Session " ++ showBytesHex bs
 
-data HandshakeType =
-      HandshakeType_HelloRequest
-    | HandshakeType_ClientHello
-    | HandshakeType_ServerHello
-    | HandshakeType_Certificate
-    | HandshakeType_ServerKeyXchg
-    | HandshakeType_CertRequest
-    | HandshakeType_ServerHelloDone
-    | HandshakeType_CertVerify
-    | HandshakeType_ClientKeyXchg
-    | HandshakeType_Finished
-    | HandshakeType_NPN -- Next Protocol Negotiation extension
-    deriving (Show,Eq)
+{-# DEPRECATED FinishedData "use VerifyData" #-}
+type FinishedData = ByteString
 
-data ServerDHParams = ServerDHParams DHParams {- (p,g) -} DHPublic {- y -}
-    deriving (Show,Eq)
+newtype VerifyData = VerifyData ByteString deriving (Eq)
+instance Show VerifyData where
+    show (VerifyData bs) = showBytesHex bs
 
-data ServerRSAParams = ServerRSAParams
-    { rsa_modulus  :: Integer
-    , rsa_exponent :: Integer
-    } deriving (Show,Eq)
+----------------------------------------------------------------
 
-data ServerKeyXchgAlgorithmData =
-      SKX_DH_Anon ServerDHParams
-    | SKX_DHE_DSS ServerDHParams DigitallySigned
-    | SKX_DHE_RSA ServerDHParams DigitallySigned
-    | SKX_RSA (Maybe ServerRSAParams)
-    | SKX_DH_DSS (Maybe ServerRSAParams)
-    | SKX_DH_RSA (Maybe ServerRSAParams)
-    | SKX_Unparsed Bytes -- if we parse the server key xchg before knowing the actual cipher, we end up with this structure.
-    | SKX_Unknown Bytes
-    deriving (Show,Eq)
+newtype HandshakeType = HandshakeType {fromHandshakeType :: Word8}
+    deriving (Eq)
 
-data ClientKeyXchgAlgorithmData =
-      CKX_RSA Bytes
-    | CKX_DH DHPublic
-    deriving (Show,Eq)
+{- FOURMOLU_DISABLE -}
+pattern HandshakeType_HelloRequest          :: HandshakeType
+pattern HandshakeType_HelloRequest           = HandshakeType 0
+pattern HandshakeType_ClientHello           :: HandshakeType
+pattern HandshakeType_ClientHello            = HandshakeType 1
+pattern HandshakeType_ServerHello           :: HandshakeType
+pattern HandshakeType_ServerHello            = HandshakeType 2
+pattern HandshakeType_NewSessionTicket      :: HandshakeType
+pattern HandshakeType_NewSessionTicket       = HandshakeType 4
+pattern HandshakeType_EndOfEarlyData        :: HandshakeType
+pattern HandshakeType_EndOfEarlyData         = HandshakeType 5
+pattern HandshakeType_EncryptedExtensions   :: HandshakeType
+pattern HandshakeType_EncryptedExtensions    = HandshakeType 8
+pattern HandshakeType_Certificate           :: HandshakeType
+pattern HandshakeType_Certificate            = HandshakeType 11
+pattern HandshakeType_ServerKeyXchg         :: HandshakeType
+pattern HandshakeType_ServerKeyXchg          = HandshakeType 12
+pattern HandshakeType_CertRequest           :: HandshakeType
+pattern HandshakeType_CertRequest            = HandshakeType 13
+pattern HandshakeType_ServerHelloDone       :: HandshakeType
+pattern HandshakeType_ServerHelloDone        = HandshakeType 14
+pattern HandshakeType_CertVerify            :: HandshakeType
+pattern HandshakeType_CertVerify             = HandshakeType 15
+pattern HandshakeType_ClientKeyXchg         :: HandshakeType
+pattern HandshakeType_ClientKeyXchg          = HandshakeType 16
+pattern HandshakeType_Finished              :: HandshakeType
+pattern HandshakeType_Finished               = HandshakeType 20
+pattern HandshakeType_KeyUpdate             :: HandshakeType
+pattern HandshakeType_KeyUpdate              = HandshakeType 24
+pattern HandshakeType_CompressedCertificate :: HandshakeType
+pattern HandshakeType_CompressedCertificate  = HandshakeType 25
 
-type DeprecatedRecord = ByteString
+instance Show HandshakeType where
+    show HandshakeType_HelloRequest          = "HelloRequest"
+    show HandshakeType_ClientHello           = "ClientHello"
+    show HandshakeType_ServerHello           = "ServerHello"
+    show HandshakeType_NewSessionTicket      = "NewSessionTicket"
+    show HandshakeType_EndOfEarlyData        = "EndOfEarlyData"
+    show HandshakeType_EncryptedExtensions   = "EncryptedExtensions"
+    show HandshakeType_Certificate           = "Certificate"
+    show HandshakeType_ServerKeyXchg         = "ServerKeyXchg"
+    show HandshakeType_CertRequest           = "CertRequest"
+    show HandshakeType_ServerHelloDone       = "ServerHelloDone"
+    show HandshakeType_CertVerify            = "CertVerify"
+    show HandshakeType_ClientKeyXchg         = "ClientKeyXchg"
+    show HandshakeType_Finished              = "Finished"
+    show HandshakeType_KeyUpdate             = "KeyUpdate"
+    show HandshakeType_CompressedCertificate = "CompressedCertificate"
+    show (HandshakeType x)                   = "HandshakeType " ++ show x
+{- FOURMOLU_ENABLE -}
 
-data Handshake =
-      ClientHello !Version !ClientRandom !Session ![CipherID] ![CompressionID] [ExtensionRaw] (Maybe DeprecatedRecord)
-    | ServerHello !Version !ServerRandom !Session !CipherID !CompressionID [ExtensionRaw]
-    | Certificates CertificateChain
-    | HelloRequest
-    | ServerHelloDone
-    | ClientKeyXchg ClientKeyXchgAlgorithmData
-    | ServerKeyXchg ServerKeyXchgAlgorithmData
-    | CertRequest [CertificateType] (Maybe [HashAndSignatureAlgorithm]) [DistinguishedName]
-    | CertVerify DigitallySigned
-    | Finished FinishedData
-    | HsNextProtocolNegotiation Bytes -- NPN extension
-    deriving (Show,Eq)
+----------------------------------------------------------------
 
-packetType :: Packet -> ProtocolType
-packetType (Handshake _)    = ProtocolType_Handshake
-packetType (Alert _)        = ProtocolType_Alert
-packetType ChangeCipherSpec = ProtocolType_ChangeCipherSpec
-packetType (AppData _)      = ProtocolType_AppData
+data ServerDHParams = ServerDHParams
+    { serverDHParams_p :: BigNum
+    , serverDHParams_g :: BigNum
+    , serverDHParams_y :: BigNum
+    }
+    deriving (Show, Eq)
 
-typeOfHandshake :: Handshake -> HandshakeType
-typeOfHandshake (ClientHello {})             = HandshakeType_ClientHello
-typeOfHandshake (ServerHello {})             = HandshakeType_ServerHello
-typeOfHandshake (Certificates {})            = HandshakeType_Certificate
-typeOfHandshake HelloRequest                 = HandshakeType_HelloRequest
-typeOfHandshake (ServerHelloDone)            = HandshakeType_ServerHelloDone
-typeOfHandshake (ClientKeyXchg {})           = HandshakeType_ClientKeyXchg
-typeOfHandshake (ServerKeyXchg {})           = HandshakeType_ServerKeyXchg
-typeOfHandshake (CertRequest {})             = HandshakeType_CertRequest
-typeOfHandshake (CertVerify {})              = HandshakeType_CertVerify
-typeOfHandshake (Finished {})                = HandshakeType_Finished
-typeOfHandshake (HsNextProtocolNegotiation {}) = HandshakeType_NPN
+serverDHParamsFrom :: DHParams -> DHPublic -> ServerDHParams
+serverDHParamsFrom params dhPub =
+    ServerDHParams
+        (bigNumFromInteger $ dhParamsGetP params)
+        (bigNumFromInteger $ dhParamsGetG params)
+        (bigNumFromInteger $ dhUnwrapPublic dhPub)
 
-numericalVer :: Version -> (Word8, Word8)
-numericalVer SSL2  = (2, 0)
-numericalVer SSL3  = (3, 0)
-numericalVer TLS10 = (3, 1)
-numericalVer TLS11 = (3, 2)
-numericalVer TLS12 = (3, 3)
+serverDHParamsToParams :: ServerDHParams -> DHParams
+serverDHParamsToParams serverParams =
+    dhParams
+        (bigNumToInteger $ serverDHParams_p serverParams)
+        (bigNumToInteger $ serverDHParams_g serverParams)
 
-verOfNum :: (Word8, Word8) -> Maybe Version
-verOfNum (2, 0) = Just SSL2
-verOfNum (3, 0) = Just SSL3
-verOfNum (3, 1) = Just TLS10
-verOfNum (3, 2) = Just TLS11
-verOfNum (3, 3) = Just TLS12
-verOfNum _      = Nothing
+serverDHParamsToPublic :: ServerDHParams -> DHPublic
+serverDHParamsToPublic serverParams =
+    dhPublic (bigNumToInteger $ serverDHParams_y serverParams)
 
-class TypeValuable a where
-    valOfType :: a -> Word8
-    valToType :: Word8 -> Maybe a
+----------------------------------------------------------------
 
-instance TypeValuable ConnectionEnd where
-    valOfType ConnectionServer = 0
-    valOfType ConnectionClient = 1
+data ServerECDHParams = ServerECDHParams Group GroupPublicA
+    deriving (Show, Eq)
 
-    valToType 0 = Just ConnectionServer
-    valToType 1 = Just ConnectionClient
-    valToType _ = Nothing
+----------------------------------------------------------------
 
-instance TypeValuable CipherType where
-    valOfType CipherStream = 0
-    valOfType CipherBlock  = 1
-    valOfType CipherAEAD   = 2
+data ServerRSAParams = ServerRSAParams
+    { rsa_modulus :: Integer
+    , rsa_exponent :: Integer
+    }
+    deriving (Show, Eq)
 
-    valToType 0 = Just CipherStream
-    valToType 1 = Just CipherBlock
-    valToType 2 = Just CipherAEAD
-    valToType _ = Nothing
+----------------------------------------------------------------
 
-instance TypeValuable ProtocolType where
-    valOfType ProtocolType_ChangeCipherSpec    = 20
-    valOfType ProtocolType_Alert               = 21
-    valOfType ProtocolType_Handshake           = 22
-    valOfType ProtocolType_AppData             = 23
-    valOfType ProtocolType_DeprecatedHandshake = 128 -- unused
+data ServerDSAParams = ServerDSAParams deriving (Show, Eq)
 
-    valToType 20 = Just ProtocolType_ChangeCipherSpec
-    valToType 21 = Just ProtocolType_Alert
-    valToType 22 = Just ProtocolType_Handshake
-    valToType 23 = Just ProtocolType_AppData
-    valToType _  = Nothing
+----------------------------------------------------------------
 
-instance TypeValuable HandshakeType where
-    valOfType HandshakeType_HelloRequest    = 0
-    valOfType HandshakeType_ClientHello     = 1
-    valOfType HandshakeType_ServerHello     = 2
-    valOfType HandshakeType_Certificate     = 11
-    valOfType HandshakeType_ServerKeyXchg   = 12
-    valOfType HandshakeType_CertRequest     = 13
-    valOfType HandshakeType_ServerHelloDone = 14
-    valOfType HandshakeType_CertVerify      = 15
-    valOfType HandshakeType_ClientKeyXchg   = 16
-    valOfType HandshakeType_Finished        = 20
-    valOfType HandshakeType_NPN             = 67
+data ServerKeyXchgAlgorithmData
+    = SKX_DH_Anon ServerDHParams
+    | SKX_DHE_DSA ServerDHParams DigitallySigned
+    | SKX_DHE_RSA ServerDHParams DigitallySigned
+    | SKX_ECDHE_RSA ServerECDHParams DigitallySigned
+    | SKX_ECDHE_ECDSA ServerECDHParams DigitallySigned
+    | SKX_RSA (Maybe ServerRSAParams)
+    | SKX_DH_DSA (Maybe ServerDSAParams)
+    | SKX_DH_RSA (Maybe ServerRSAParams)
+    | SKX_Unparsed ByteString -- if we parse the server key xchg before knowing the actual cipher, we end up with this structure.
+    | SKX_Unknown ByteString
+    deriving (Eq)
 
-    valToType 0  = Just HandshakeType_HelloRequest
-    valToType 1  = Just HandshakeType_ClientHello
-    valToType 2  = Just HandshakeType_ServerHello
-    valToType 11 = Just HandshakeType_Certificate
-    valToType 12 = Just HandshakeType_ServerKeyXchg
-    valToType 13 = Just HandshakeType_CertRequest
-    valToType 14 = Just HandshakeType_ServerHelloDone
-    valToType 15 = Just HandshakeType_CertVerify
-    valToType 16 = Just HandshakeType_ClientKeyXchg
-    valToType 20 = Just HandshakeType_Finished
-    valToType 67 = Just HandshakeType_NPN
-    valToType _  = Nothing
+{- FOURMOLU_DISABLE -}
+instance Show ServerKeyXchgAlgorithmData where
+    show (SKX_DH_Anon _)       = "SKX_DH_Anon"
+    show (SKX_DHE_DSA _ _)     = "SKX_DHE_DSA"
+    show (SKX_DHE_RSA _ _)     = "SKX_DHE_RSA"
+    show (SKX_ECDHE_RSA _ _)   = "SKX_ECDHE_RSA"
+    show (SKX_ECDHE_ECDSA _ _) = "SKX_ECDHE_ECDSA"
+    show (SKX_RSA _)           = "SKX_RSA"
+    show (SKX_DH_DSA _)        = "SKX_DH_DSA"
+    show (SKX_DH_RSA _)        = "SKX_DH_RSA"
+    show (SKX_Unparsed _)      = "SKX_Unparsed"
+    show (SKX_Unknown _)       = "SKX_Unknown"
+{- FOURMOLU_ENABLE -}
 
-instance TypeValuable AlertLevel where
-    valOfType AlertLevel_Warning = 1
-    valOfType AlertLevel_Fatal   = 2
+----------------------------------------------------------------
 
-    valToType 1 = Just AlertLevel_Warning
-    valToType 2 = Just AlertLevel_Fatal
-    valToType _ = Nothing
+data ClientKeyXchgAlgorithmData
+    = CKX_RSA ByteString
+    | CKX_DH DHPublic
+    | CKX_ECDH ByteString
+    deriving (Eq)
 
-instance TypeValuable AlertDescription where
-    valOfType CloseNotify            = 0
-    valOfType UnexpectedMessage      = 10
-    valOfType BadRecordMac           = 20
-    valOfType DecryptionFailed       = 21
-    valOfType RecordOverflow         = 22
-    valOfType DecompressionFailure   = 30
-    valOfType HandshakeFailure       = 40
-    valOfType BadCertificate         = 42
-    valOfType UnsupportedCertificate = 43
-    valOfType CertificateRevoked     = 44
-    valOfType CertificateExpired     = 45
-    valOfType CertificateUnknown     = 46
-    valOfType IllegalParameter       = 47
-    valOfType UnknownCa              = 48
-    valOfType AccessDenied           = 49
-    valOfType DecodeError            = 50
-    valOfType DecryptError           = 51
-    valOfType ExportRestriction      = 60
-    valOfType ProtocolVersion        = 70
-    valOfType InsufficientSecurity   = 71
-    valOfType InternalError          = 80
-    valOfType UserCanceled           = 90
-    valOfType NoRenegotiation        = 100
-    valOfType UnsupportedExtension   = 110
-    valOfType CertificateUnobtainable = 111
-    valOfType UnrecognizedName        = 112
-    valOfType BadCertificateStatusResponse = 113
-    valOfType BadCertificateHashValue = 114
+instance Show ClientKeyXchgAlgorithmData where
+    show (CKX_RSA _bs) = "CKX_RSA \"...\""
+    show (CKX_DH pub) = "CKX_DH " ++ show pub
+    show (CKX_ECDH _bs) = "CKX_ECDH \"...\""
 
-    valToType 0   = Just CloseNotify
-    valToType 10  = Just UnexpectedMessage
-    valToType 20  = Just BadRecordMac
-    valToType 21  = Just DecryptionFailed
-    valToType 22  = Just RecordOverflow
-    valToType 30  = Just DecompressionFailure
-    valToType 40  = Just HandshakeFailure
-    valToType 42  = Just BadCertificate
-    valToType 43  = Just UnsupportedCertificate
-    valToType 44  = Just CertificateRevoked
-    valToType 45  = Just CertificateExpired
-    valToType 46  = Just CertificateUnknown
-    valToType 47  = Just IllegalParameter
-    valToType 48  = Just UnknownCa
-    valToType 49  = Just AccessDenied
-    valToType 50  = Just DecodeError
-    valToType 51  = Just DecryptError
-    valToType 60  = Just ExportRestriction
-    valToType 70  = Just ProtocolVersion
-    valToType 71  = Just InsufficientSecurity
-    valToType 80  = Just InternalError
-    valToType 90  = Just UserCanceled
-    valToType 100 = Just NoRenegotiation
-    valToType 110 = Just UnsupportedExtension
-    valToType 111 = Just CertificateUnobtainable
-    valToType 112 = Just UnrecognizedName
-    valToType 113 = Just BadCertificateStatusResponse
-    valToType 114 = Just BadCertificateHashValue
-    valToType _   = Nothing
+----------------------------------------------------------------
 
-instance TypeValuable CertificateType where
-    valOfType CertificateType_RSA_Sign         = 1
-    valOfType CertificateType_DSS_Sign         = 2
-    valOfType CertificateType_RSA_Fixed_DH     = 3
-    valOfType CertificateType_DSS_Fixed_DH     = 4
-    valOfType CertificateType_RSA_Ephemeral_DH = 5
-    valOfType CertificateType_DSS_Ephemeral_DH = 6
-    valOfType CertificateType_fortezza_dms     = 20
-    valOfType (CertificateType_Unknown i)      = i
+newtype CertificateChain_ = CertificateChain_ CertificateChain deriving (Eq)
+instance Show CertificateChain_ where
+    show (CertificateChain_ cc) = showCertificateChain cc
 
-    valToType 1  = Just CertificateType_RSA_Sign
-    valToType 2  = Just CertificateType_DSS_Sign
-    valToType 3  = Just CertificateType_RSA_Fixed_DH
-    valToType 4  = Just CertificateType_DSS_Fixed_DH
-    valToType 5  = Just CertificateType_RSA_Ephemeral_DH
-    valToType 6  = Just CertificateType_DSS_Ephemeral_DH
-    valToType 20 = Just CertificateType_fortezza_dms
-    valToType i  = Just (CertificateType_Unknown i)
+emptyCertificateChain_ :: CertificateChain_
+emptyCertificateChain_ = CertificateChain_ (CertificateChain [])
 
-instance TypeValuable HashAlgorithm where
-    valOfType HashNone      = 0
-    valOfType HashMD5       = 1
-    valOfType HashSHA1      = 2
-    valOfType HashSHA224    = 3
-    valOfType HashSHA256    = 4
-    valOfType HashSHA384    = 5
-    valOfType HashSHA512    = 6
-    valOfType (HashOther i) = i
+showCertificateChain :: CertificateChain -> String
+showCertificateChain (CertificateChain xs) = show $ map getName xs
+  where
+    getName =
+        maybe "" getCharacterStringRawData
+            . lookup [2, 5, 4, 3]
+            . getDistinguishedElements
+            . certSubjectDN
+            . signedObject
+            . getSigned
 
-    valToType 0 = Just HashNone
-    valToType 1 = Just HashMD5
-    valToType 2 = Just HashSHA1
-    valToType 3 = Just HashSHA224
-    valToType 4 = Just HashSHA256
-    valToType 5 = Just HashSHA384
-    valToType 6 = Just HashSHA512
-    valToType i = Just (HashOther i)
+data ClientHello = CH
+    { chVersion :: Version
+    , chRandom :: ClientRandom
+    , chSession :: Session
+    , chCiphers :: [CipherId]
+    , chComps :: [CompressionID]
+    , chExtensions :: [ExtensionRaw]
+    }
+    deriving (Eq, Show)
 
-instance TypeValuable SignatureAlgorithm where
-    valOfType SignatureAnonymous = 0
-    valOfType SignatureRSA       = 1
-    valOfType SignatureDSS       = 2
-    valOfType SignatureECDSA     = 3
-    valOfType (SignatureOther i) = i
+data ServerHello = SH
+    { shVersion :: Version
+    , shRandom :: ServerRandom
+    , shSession :: Session
+    , shCipher :: CipherId
+    , shComp :: CompressionID
+    , shExtensions :: [ExtensionRaw]
+    }
+    deriving (Eq, Show)
 
-    valToType 0 = Just SignatureAnonymous
-    valToType 1 = Just SignatureRSA
-    valToType 2 = Just SignatureDSS
-    valToType 3 = Just SignatureECDSA
-    valToType i = Just (SignatureOther i)
+data Handshake
+    = ClientHello ClientHello
+    | ServerHello ServerHello
+    | Certificate CertificateChain_
+    | HelloRequest
+    | ServerHelloDone
+    | ClientKeyXchg ClientKeyXchgAlgorithmData
+    | ServerKeyXchg ServerKeyXchgAlgorithmData
+    | CertRequest
+        [CertificateType]
+        [HashAndSignatureAlgorithm]
+        [DistinguishedName]
+    | CertVerify DigitallySigned
+    | Finished VerifyData
+    | NewSessionTicket Second Ticket
+    deriving (Show, Eq)
+
+{- FOURMOLU_DISABLE -}
+packetType :: Packet -> ProtocolType
+packetType (Handshake _ _)  = ProtocolType_Handshake
+packetType (Alert _)        = ProtocolType_Alert
+packetType ChangeCipherSpec = ProtocolType_ChangeCipherSpec
+packetType (AppData _)      = ProtocolType_AppData
+
+typeOfHandshake :: Handshake -> HandshakeType
+typeOfHandshake ClientHello{}      = HandshakeType_ClientHello
+typeOfHandshake ServerHello{}      = HandshakeType_ServerHello
+typeOfHandshake Certificate{}      = HandshakeType_Certificate
+typeOfHandshake HelloRequest       = HandshakeType_HelloRequest
+typeOfHandshake ServerHelloDone    = HandshakeType_ServerHelloDone
+typeOfHandshake ClientKeyXchg{}    = HandshakeType_ClientKeyXchg
+typeOfHandshake ServerKeyXchg{}    = HandshakeType_ServerKeyXchg
+typeOfHandshake CertRequest{}      = HandshakeType_CertRequest
+typeOfHandshake CertVerify{}       = HandshakeType_CertVerify
+typeOfHandshake Finished{}         = HandshakeType_Finished
+typeOfHandshake NewSessionTicket{} = HandshakeType_NewSessionTicket
+{- FOURMOLU_ENABLE -}
+
+type HandshakeR = (Handshake, WireBytes)
diff --git a/Network/TLS/Struct13.hs b/Network/TLS/Struct13.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Struct13.hs
@@ -0,0 +1,81 @@
+module Network.TLS.Struct13 (
+    Packet13 (..),
+    Handshake13 (..),
+    typeOfHandshake13,
+    contentType,
+    KeyUpdate (..),
+    CertReqContext,
+    isKeyUpdate13,
+    TicketNonce (..),
+    SessionIDorTicket_ (..),
+    Handshake13R,
+) where
+
+import Network.TLS.Imports
+import Network.TLS.Struct
+import Network.TLS.Types
+
+data Packet13
+    = Handshake13 [Handshake13] [WireBytes]
+    | Alert13 [(AlertLevel, AlertDescription)]
+    | ChangeCipherSpec13
+    | AppData13 ByteString
+    deriving (Show, Eq)
+
+data KeyUpdate
+    = UpdateNotRequested
+    | UpdateRequested
+    deriving (Show, Eq)
+
+newtype TicketNonce = TicketNonce ByteString deriving (Eq)
+
+instance Show TicketNonce where
+    show (TicketNonce bs) = showBytesHex bs
+
+newtype SessionIDorTicket_ = SessionIDorTicket_ ByteString deriving (Eq)
+
+instance Show SessionIDorTicket_ where
+    show (SessionIDorTicket_ bs) = showBytesHex bs
+
+-- fixme: convert Word32 to proper data type
+data Handshake13
+    = ServerHello13 ServerHello
+    | NewSessionTicket13 Second Word32 TicketNonce SessionIDorTicket_ [ExtensionRaw]
+    | EndOfEarlyData13
+    | EncryptedExtensions13 [ExtensionRaw]
+    | Certificate13 CertReqContext CertificateChain_ [[ExtensionRaw]]
+    | CertRequest13 CertReqContext [ExtensionRaw]
+    | CertVerify13 DigitallySigned
+    | Finished13 VerifyData
+    | KeyUpdate13 KeyUpdate
+    | CompressedCertificate13 CertReqContext CertificateChain_ [[ExtensionRaw]]
+    deriving (Show, Eq)
+
+-- | Certificate request context for TLS 1.3.
+type CertReqContext = ByteString
+
+{- FOURMOLU_DISABLE -}
+typeOfHandshake13 :: Handshake13 -> HandshakeType
+typeOfHandshake13 ServerHello13{}           = HandshakeType_ServerHello
+typeOfHandshake13 NewSessionTicket13{}      = HandshakeType_NewSessionTicket
+typeOfHandshake13 EndOfEarlyData13{}        = HandshakeType_EndOfEarlyData
+typeOfHandshake13 EncryptedExtensions13{}   = HandshakeType_EncryptedExtensions
+typeOfHandshake13 Certificate13{}           = HandshakeType_Certificate
+typeOfHandshake13 CertRequest13{}           = HandshakeType_CertRequest
+typeOfHandshake13 CertVerify13{}            = HandshakeType_CertVerify
+typeOfHandshake13 Finished13{}              = HandshakeType_Finished
+typeOfHandshake13 KeyUpdate13{}             = HandshakeType_KeyUpdate
+typeOfHandshake13 CompressedCertificate13{} = HandshakeType_CompressedCertificate
+
+contentType :: Packet13 -> ProtocolType
+contentType ChangeCipherSpec13 = ProtocolType_ChangeCipherSpec
+contentType Handshake13{}      = ProtocolType_Handshake
+contentType Alert13{}          = ProtocolType_Alert
+contentType AppData13{}        = ProtocolType_AppData
+{- FOURMOLU_ENABLE -}
+
+isKeyUpdate13 :: Handshake13 -> Bool
+isKeyUpdate13 (KeyUpdate13 _) = True
+isKeyUpdate13 _ = False
+
+type Handshake13R = (Handshake13, WireBytes)
diff --git a/Network/TLS/Types.hs b/Network/TLS/Types.hs
--- a/Network/TLS/Types.hs
+++ b/Network/TLS/Types.hs
@@ -1,53 +1,71 @@
--- |
--- Module      : Network.TLS.Types
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
-module Network.TLS.Types
-    ( Version(..)
-    , SessionID
-    , SessionData(..)
-    , CipherID
-    , CompressionID
-    , Role(..)
-    , invertRole
-    , Direction(..)
-    ) where
-
-import Data.ByteString (ByteString)
-import Data.Word
-
--- | Versions known to TLS
---
--- SSL2 is just defined, but this version is and will not be supported.
-data Version = SSL2 | SSL3 | TLS10 | TLS11 | TLS12 deriving (Show, Eq, Ord)
-
--- | A session ID
-type SessionID = ByteString
+module Network.TLS.Types (
+    module Network.TLS.Types.Cipher,
+    module Network.TLS.Types.Secret,
+    module Network.TLS.Types.Session,
+    module Network.TLS.Types.Version,
+    HostName,
+    Role (..),
+    invertRole,
+    Direction (..),
+    BigNum (..),
+    bigNumToInteger,
+    bigNumFromInteger,
+    defaultRecordSizeLimit,
+    TranscriptHash (..),
+    WireBytes,
+) where
 
--- | Session data to resume
-data SessionData = SessionData
-    { sessionVersion :: Version
-    , sessionCipher  :: CipherID
-    , sessionSecret  :: ByteString
-    } deriving (Show,Eq)
+import Network.Socket (HostName)
 
--- | Cipher identification
-type CipherID = Word16
+import Network.TLS.Imports
+import Network.TLS.Types.Cipher
+import Network.TLS.Types.Secret
+import Network.TLS.Types.Session
+import Network.TLS.Types.Version
+import Network.TLS.Util.Serialization
 
--- | Compression identification
-type CompressionID = Word8
+----------------------------------------------------------------
 
 -- | Role
 data Role = ClientRole | ServerRole
-    deriving (Show,Eq)
-
--- | Direction
-data Direction = Tx | Rx
-    deriving (Show,Eq)
+    deriving (Show, Eq)
 
 invertRole :: Role -> Role
 invertRole ClientRole = ServerRole
 invertRole ServerRole = ClientRole
+
+----------------------------------------------------------------
+
+-- | Direction
+data Direction = Tx | Rx
+    deriving (Show, Eq)
+
+----------------------------------------------------------------
+
+newtype BigNum = BigNum ByteString
+    deriving (Show, Eq)
+
+bigNumToInteger :: BigNum -> Integer
+bigNumToInteger (BigNum b) = os2ip b
+
+bigNumFromInteger :: Integer -> BigNum
+bigNumFromInteger i = BigNum $ i2osp i
+
+----------------------------------------------------------------
+
+-- For plaintext
+-- 2^14 for TLS 1.2
+-- 2^14 + 1 for TLS 1.3
+defaultRecordSizeLimit :: Int
+defaultRecordSizeLimit = 16384
+
+----------------------------------------------------------------
+
+newtype TranscriptHash = TranscriptHash ByteString
+
+instance Show TranscriptHash where
+    show (TranscriptHash bs) = showBytesHex bs
+
+----------------------------------------------------------------
+
+type WireBytes = [ByteString]
diff --git a/Network/TLS/Types/Cipher.hs b/Network/TLS/Types/Cipher.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Types/Cipher.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Network.TLS.Types.Cipher where
+
+import Crypto.Cipher.Types (AuthTag)
+import Data.ByteArray (ScrubbedBytes)
+import Data.IORef
+import GHC.Generics
+import System.IO.Unsafe (unsafePerformIO)
+import Text.Printf
+
+import Network.TLS.Crypto (Hash (..))
+import Network.TLS.Imports
+import Network.TLS.Types.Version
+
+----------------------------------------------------------------
+
+type PlainText = ByteString
+type CipherText = ByteString
+type Secret = ScrubbedBytes
+type Key = ScrubbedBytes
+type IV = ByteString
+type Nonce = ByteString -- aka IV
+type AddDat = ByteString
+
+----------------------------------------------------------------
+
+-- | Cipher identification
+type CipherID = Word16
+
+newtype CipherId = CipherId {fromCipherId :: Word16}
+    deriving (Eq, Ord, Enum, Num, Integral, Real, Read, Generic)
+
+instance Show CipherId where
+    show (CipherId 0x00FF) = "TLS_EMPTY_RENEGOTIATION_INFO_SCSV"
+    show (CipherId n) = case find eqID dict of
+        Just c -> cipherName c
+        Nothing -> printf "0x%04X" n
+      where
+        eqID c = cipherID c == n
+        dict = unsafePerformIO $ readIORef globalCipherDict
+
+-- "ciphersuite" is designed extensible.
+-- So, it's not available from internal modules.
+-- This is a compromise to gule "ciphersuite" to Show CipherID.
+
+{-# NOINLINE globalCipherDict #-}
+globalCipherDict :: IORef [Cipher]
+globalCipherDict = unsafePerformIO $ newIORef []
+
+----------------------------------------------------------------
+
+-- | Cipher algorithm
+data Cipher = Cipher
+    { cipherID :: CipherID
+    , cipherName :: String
+    , cipherHash :: Hash
+    , cipherBulk :: Bulk
+    , cipherKeyExchange :: CipherKeyExchangeType
+    , cipherMinVer :: Maybe Version
+    , cipherPRFHash :: Maybe Hash
+    }
+
+instance Show Cipher where
+    show c = cipherName c
+
+instance Eq Cipher where
+    (==) c1 c2 = cipherID c1 == cipherID c2
+
+----------------------------------------------------------------
+
+data CipherKeyExchangeType
+    = CipherKeyExchange_RSA
+    | CipherKeyExchange_DH_Anon
+    | CipherKeyExchange_DHE_RSA
+    | CipherKeyExchange_ECDHE_RSA
+    | CipherKeyExchange_DHE_DSA
+    | CipherKeyExchange_DH_DSA
+    | CipherKeyExchange_DH_RSA
+    | CipherKeyExchange_ECDH_ECDSA
+    | CipherKeyExchange_ECDH_RSA
+    | CipherKeyExchange_ECDHE_ECDSA
+    | CipherKeyExchange_TLS13 -- not expressed in cipher suite
+    deriving (Show, Eq)
+
+----------------------------------------------------------------
+
+data Bulk = Bulk
+    { bulkName :: String
+    , bulkKeySize :: Int
+    , bulkIVSize :: Int
+    , bulkExplicitIV :: Int -- Explicit size for IV for AEAD Cipher, 0 otherwise
+    , bulkAuthTagLen :: Int -- Authentication tag length in bytes for AEAD Cipher, 0 otherwise
+    , bulkBlockSize :: Int
+    , bulkF :: BulkFunctions
+    }
+
+instance Show Bulk where
+    show bulk = bulkName bulk
+instance Eq Bulk where
+    b1 == b2 =
+        and
+            [ bulkName b1 == bulkName b2
+            , bulkKeySize b1 == bulkKeySize b2
+            , bulkIVSize b1 == bulkIVSize b2
+            , bulkBlockSize b1 == bulkBlockSize b2
+            ]
+
+----------------------------------------------------------------
+
+data BulkFunctions
+    = BulkBlockF (BulkDirection -> BulkKey -> BulkBlock)
+    | BulkStreamF (BulkDirection -> BulkKey -> BulkStream)
+    | BulkAeadF (BulkDirection -> BulkKey -> BulkAEAD)
+
+data BulkDirection = BulkEncrypt | BulkDecrypt
+    deriving (Show, Eq)
+
+type BulkKey = Secret
+type BulkIV = Nonce
+type BulkNonce = Nonce
+type BulkAdditionalData = ByteString
+
+type BulkBlock = BulkIV -> ByteString -> (ByteString, BulkIV)
+
+newtype BulkStream = BulkStream (ByteString -> (ByteString, BulkStream))
+
+type BulkAEAD =
+    BulkNonce -> ByteString -> BulkAdditionalData -> (ByteString, AuthTag)
diff --git a/Network/TLS/Types/Secret.hs b/Network/TLS/Types/Secret.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Types/Secret.hs
@@ -0,0 +1,62 @@
+module Network.TLS.Types.Secret where
+
+import Data.ByteArray (convert)
+import Network.TLS.Imports
+import Network.TLS.Types.Cipher
+
+-- | Phantom type indicating early traffic secret.
+data EarlySecret
+
+-- | Phantom type indicating handshake traffic secrets.
+data HandshakeSecret
+
+-- | Phantom type indicating application traffic secrets.
+data ApplicationSecret
+
+data ResumptionSecret
+
+newtype BaseSecret a = BaseSecret Secret
+
+instance Show (BaseSecret a) where
+    show (BaseSecret bs) = showBytesHex $ convert bs
+
+newtype AnyTrafficSecret a = AnyTrafficSecret Secret
+
+instance Show (AnyTrafficSecret a) where
+    show (AnyTrafficSecret bs) = showBytesHex $ convert bs
+
+-- | A client traffic secret, typed with a parameter indicating a step in the
+-- TLS key schedule.
+newtype ClientTrafficSecret a = ClientTrafficSecret Secret
+
+instance Show (ClientTrafficSecret a) where
+    show (ClientTrafficSecret bs) = showBytesHex $ convert bs
+
+-- | A server traffic secret, typed with a parameter indicating a step in the
+-- TLS key schedule.
+newtype ServerTrafficSecret a = ServerTrafficSecret Secret
+
+instance Show (ServerTrafficSecret a) where
+    show (ServerTrafficSecret bs) = showBytesHex $ convert bs
+
+data SecretTriple a = SecretTriple
+    { triBase :: BaseSecret a
+    , triClient :: ClientTrafficSecret a
+    , triServer :: ServerTrafficSecret a
+    }
+    deriving (Show)
+
+data SecretPair a = SecretPair
+    { pairBase :: BaseSecret a
+    , pairClient :: ClientTrafficSecret a
+    }
+    deriving (Show)
+
+-- | Hold both client and server traffic secrets at the same step.
+type TrafficSecrets a = (ClientTrafficSecret a, ServerTrafficSecret a)
+
+-- Main secret for TLS 1.2 or earlier.
+newtype MainSecret = MainSecret Secret
+
+instance Show MainSecret where
+    show (MainSecret bs) = showBytesHex $ convert bs
diff --git a/Network/TLS/Types/Session.hs b/Network/TLS/Types/Session.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Types/Session.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Network.TLS.Types.Session where
+
+import Codec.Serialise
+import qualified Data.ByteString as B
+import GHC.Generics
+import Network.Socket (HostName)
+
+import Network.TLS.Crypto (Group, Hash (..), hash)
+import Network.TLS.Imports
+import Network.TLS.Types.Cipher
+import Network.TLS.Types.Version
+
+-- | A session ID
+type SessionID = ByteString
+
+-- | Identity
+type SessionIDorTicket = ByteString
+
+-- | Encrypted session ticket (encrypt(encode 'SessionData')).
+type Ticket = ByteString
+
+isTicket :: SessionIDorTicket -> Bool
+isTicket x
+    | B.length x > 32 = True
+    | otherwise = False
+
+toSessionID :: Ticket -> SessionID
+toSessionID = hash SHA256
+
+-- | Compression identification
+type CompressionID = Word8
+
+-- | Session data to resume
+data SessionData = SessionData
+    { sessionVersion :: Version
+    , sessionCipher :: CipherID
+    , sessionCompression :: CompressionID
+    , sessionClientSNI :: Maybe HostName
+    , -- ScrubbedBytes is not an instance of Generic, sigh.
+      sessionSecret :: ByteString
+    , sessionGroup :: Maybe Group
+    , sessionTicketInfo :: Maybe TLS13TicketInfo
+    , sessionALPN :: Maybe ByteString
+    , sessionMaxEarlyDataSize :: Int
+    , sessionFlags :: [SessionFlag]
+    } -- sessionFromTicket :: Bool
+    deriving (Show, Eq, Generic)
+
+is0RTTPossible :: SessionData -> Bool
+is0RTTPossible sd = sessionMaxEarlyDataSize sd > 0
+
+-- | Some session flags
+data SessionFlag
+    = -- | Session created with Extended Main Secret
+      SessionEMS
+    deriving (Show, Eq, Enum, Generic)
+
+type Second = Word32
+type Millisecond = Word64
+
+data TLS13TicketInfo = TLS13TicketInfo
+    { lifetime :: Second -- NewSessionTicket.ticket_lifetime in seconds
+    , ageAdd :: Second -- NewSessionTicket.ticket_age_add
+    , txrxTime :: Millisecond -- serverSendTime or clientReceiveTime
+    , estimatedRTT :: Maybe Millisecond
+    }
+    deriving (Show, Eq, Generic)
+
+instance Serialise TLS13TicketInfo
+instance Serialise SessionFlag
+instance Serialise SessionData
diff --git a/Network/TLS/Types/Version.hs b/Network/TLS/Types/Version.hs
new file mode 100644
--- /dev/null
+++ b/Network/TLS/Types/Version.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Network.TLS.Types.Version (
+    Version (Version, SSL2, SSL3, TLS10, TLS11, TLS12, TLS13),
+) where
+
+import Codec.Serialise
+import GHC.Generics
+
+import Network.TLS.Imports
+
+-- | Versions known to TLS
+newtype Version = Version Word16 deriving (Eq, Ord, Generic)
+
+{- FOURMOLU_DISABLE -}
+pattern SSL2  :: Version
+pattern SSL2   = Version 0x0002
+pattern SSL3  :: Version
+pattern SSL3   = Version 0x0300
+pattern TLS10 :: Version
+pattern TLS10  = Version 0x0301
+pattern TLS11 :: Version
+pattern TLS11  = Version 0x0302
+pattern TLS12 :: Version
+pattern TLS12  = Version 0x0303
+pattern TLS13 :: Version
+pattern TLS13  = Version 0x0304
+
+instance Show Version where
+    show SSL2  = "SSL2"
+    show SSL3  = "SSL3"
+    show TLS10 = "TLS1.0"
+    show TLS11 = "TLS1.1"
+    show TLS12 = "TLS1.2"
+    show TLS13 = "TLS1.3"
+    show (Version x) = "Version " ++ show x
+{- FOURMOLU_ENABLE -}
+
+instance Serialise Version
diff --git a/Network/TLS/Util.hs b/Network/TLS/Util.hs
--- a/Network/TLS/Util.hs
+++ b/Network/TLS/Util.hs
@@ -1,85 +1,125 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-module Network.TLS.Util
-        ( sub
-        , takelast
-        , partition3
-        , partition6
-        , fromJust
-        , and'
-        , (&&!)
-        , bytesEq
-        , fmapEither
-        , catchException
-        ) where
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
-import Data.List (foldl')
-import Network.TLS.Struct (Bytes)
-import qualified Data.ByteString as B
+module Network.TLS.Util (
+    sub,
+    takelast,
+    partition3,
+    partition6,
+    (&&!),
+    fmapEither,
+    catchException,
+    forEitherM,
+    mapChunks_,
+    getChunks,
+    Saved,
+    saveMVar,
+    restoreMVar,
+) where
 
-import Control.Exception (fromException)
+import Control.Concurrent.MVar
+import Control.Exception (SomeAsyncException (..))
 import qualified Control.Exception as E
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as B
 
-sub :: Bytes -> Int -> Int -> Maybe Bytes
+import Network.TLS.Imports
+
+sub :: ByteString -> Int -> Int -> Maybe ByteString
 sub b offset len
     | B.length b < offset + len = Nothing
-    | otherwise                 = Just $ B.take len $ snd $ B.splitAt offset b
+    | otherwise = Just $ B.take len $ snd $ B.splitAt offset b
 
-takelast :: Int -> Bytes -> Maybe Bytes
+takelast :: Int -> ByteString -> Maybe ByteString
 takelast i b
     | B.length b >= i = sub b (B.length b - i) i
-    | otherwise       = Nothing
+    | otherwise = Nothing
 
-partition3 :: Bytes -> (Int,Int,Int) -> Maybe (Bytes, Bytes, Bytes)
-partition3 bytes (d1,d2,d3)
-    | any (< 0) l             = Nothing
+partition3
+    :: ByteString -> (Int, Int, Int) -> Maybe (ByteString, ByteString, ByteString)
+partition3 bytes (d1, d2, d3)
+    | any (< 0) l = Nothing
     | sum l /= B.length bytes = Nothing
-    | otherwise               = Just (p1,p2,p3)
-        where l        = [d1,d2,d3]
-              (p1, r1) = B.splitAt d1 bytes
-              (p2, r2) = B.splitAt d2 r1
-              (p3, _)  = B.splitAt d3 r2
-
-partition6 :: Bytes -> (Int,Int,Int,Int,Int,Int) -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes, Bytes)
-partition6 bytes (d1,d2,d3,d4,d5,d6) = if B.length bytes < s then Nothing else Just (p1,p2,p3,p4,p5,p6)
-  where s        = sum [d1,d2,d3,d4,d5,d6]
-        (p1, r1) = B.splitAt d1 bytes
-        (p2, r2) = B.splitAt d2 r1
-        (p3, r3) = B.splitAt d3 r2
-        (p4, r4) = B.splitAt d4 r3
-        (p5, r5) = B.splitAt d5 r4
-        (p6, _)  = B.splitAt d6 r5
-
-fromJust :: String -> Maybe a -> a
-fromJust what Nothing  = error ("fromJust " ++ what ++ ": Nothing") -- yuck
-fromJust _    (Just x) = x
+    | otherwise = Just (p1, p2, p3)
+  where
+    l = [d1, d2, d3]
+    (p1, r1) = B.splitAt d1 bytes
+    (p2, r2) = B.splitAt d2 r1
+    (p3, _) = B.splitAt d3 r2
 
--- | This is a strict version of and
-and' :: [Bool] -> Bool
-and' l = foldl' (&&!) True l
+partition6
+    :: ScrubbedBytes
+    -> (Int, Int, Int, Int, Int, Int)
+    -> Maybe
+        ( ScrubbedBytes
+        , ScrubbedBytes
+        , ScrubbedBytes
+        , ScrubbedBytes
+        , ScrubbedBytes
+        , ScrubbedBytes
+        )
+partition6 bytes (d1, d2, d3, d4, d5, d6) = if BA.length bytes < s then Nothing else Just (p1, p2, p3, p4, p5, p6)
+  where
+    slice' (beg, len) = BA.unsafeSlice bytes beg len
+    lens = [d1, d2, d3, d4, d5, d6]
+    s = sum lens
+    begs = scanl (+) 0 lens
+    ys = zip begs lens
+    [p1, p2, p3, p4, p5, p6] = map slice' ys
 
 -- | This is a strict version of &&.
 (&&!) :: Bool -> Bool -> Bool
-True  &&! True  = True
-True  &&! False = False
-False &&! True  = False
+True &&! True = True
+True &&! False = False
+False &&! True = False
 False &&! False = False
 
--- | verify that 2 bytestrings are equals.
--- it's a non lazy version, that will compare every bytes.
--- arguments with different length will bail out early
-bytesEq :: Bytes -> Bytes -> Bool
-bytesEq b1 b2
-    | B.length b1 /= B.length b2 = False
-    | otherwise                  = and' $ B.zipWith (==) b1 b2
-
 fmapEither :: (a -> b) -> Either l a -> Either l b
-fmapEither f e = case e of
-    Left l  -> Left l
-    Right r -> Right (f r)
+fmapEither f = fmap f
 
 catchException :: IO a -> (E.SomeException -> IO a) -> IO a
 catchException f handler = E.catchJust filterExn f handler
-  where filterExn :: E.SomeException -> Maybe E.SomeException
-        filterExn e = case fromException e of
-                            Just (_ :: E.AsyncException) -> Nothing
-                            Nothing                      -> Just e
+  where
+    filterExn :: E.SomeException -> Maybe E.SomeException
+    filterExn e = case E.fromException (E.toException e) of
+        Just (SomeAsyncException _) -> Nothing
+        Nothing -> Just e
+
+forEitherM :: Monad m => [a] -> (a -> m (Either l b)) -> m (Either l [b])
+forEitherM [] _ = return (pure [])
+forEitherM (x : xs) f = f x >>= doTail
+  where
+    doTail (Right b) = fmap (b :) <$> forEitherM xs f
+    doTail (Left e) = return (Left e)
+
+mapChunks_
+    :: Monad m
+    => Maybe Int
+    -> (ByteString -> m a)
+    -> ByteString
+    -> m ()
+mapChunks_ len f = mapM_ f . getChunks len
+
+getChunks :: Maybe Int -> ByteString -> [ByteString]
+getChunks Nothing = (: [])
+getChunks (Just len) = go
+  where
+    go bs
+        | B.length bs > len =
+            let (chunk, remain) = B.splitAt len bs
+             in chunk : go remain
+        | otherwise = [bs]
+
+-- | An opaque newtype wrapper to prevent from poking inside content that has
+-- been saved.
+newtype Saved a = Saved a
+
+-- | Save the content of an 'MVar' to restore it later.
+saveMVar :: MVar a -> IO (Saved a)
+saveMVar ref = Saved <$> readMVar ref
+
+-- | Restore the content of an 'MVar' to a previous saved value and return the
+-- content that has just been replaced.
+restoreMVar :: MVar a -> Saved a -> IO (Saved a)
+restoreMVar ref (Saved val) = Saved <$> swapMVar ref val
diff --git a/Network/TLS/Util/ASN1.hs b/Network/TLS/Util/ASN1.hs
--- a/Network/TLS/Util/ASN1.hs
+++ b/Network/TLS/Util/ASN1.hs
@@ -1,37 +1,32 @@
--- |
--- Module      : Network.TLS.Util.ASN1
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- ASN1 utils for TLS
---
-module Network.TLS.Util.ASN1
-    ( decodeASN1Object
-    , encodeASN1Object
-    ) where
+-- | ASN1 utils for TLS
+module Network.TLS.Util.ASN1 (
+    decodeASN1Object,
+    encodeASN1Object,
+) where
 
-import Data.ASN1.Types (fromASN1, toASN1, ASN1Object)
+import Data.ASN1.BinaryEncoding (DER (..))
 import Data.ASN1.Encoding (decodeASN1', encodeASN1')
-import Data.ASN1.BinaryEncoding (DER(..))
-import Data.ByteString (ByteString)
+import Data.ASN1.Types (ASN1Object, fromASN1, toASN1)
 
+import Network.TLS.Imports
+
 -- | Attempt to decode a bytestring representing
 -- an DER ASN.1 serialized object into the object.
-decodeASN1Object :: ASN1Object a
-                 => String
-                 -> ByteString
-                 -> Either String a
+decodeASN1Object
+    :: ASN1Object a
+    => String
+    -> ByteString
+    -> Either String a
 decodeASN1Object name bs =
     case decodeASN1' DER bs of
-        Left e     -> Left (name ++ ": cannot decode ASN1: " ++ show e)
+        Left e -> Left (name ++ ": cannot decode ASN1: " ++ show e)
         Right asn1 -> case fromASN1 asn1 of
-                            Left e      -> Left (name ++ ": cannot parse ASN1: " ++ show e)
-                            Right (d,_) -> Right d
+            Left e -> Left (name ++ ": cannot parse ASN1: " ++ show e)
+            Right (d, _) -> Right d
 
 -- | Encode an ASN.1 Object to the DER serialized bytestring
-encodeASN1Object :: ASN1Object a
-                 => a
-                 -> ByteString
+encodeASN1Object
+    :: ASN1Object a
+    => a
+    -> ByteString
 encodeASN1Object obj = encodeASN1' DER $ toASN1 obj []
diff --git a/Network/TLS/Util/Serialization.hs b/Network/TLS/Util/Serialization.hs
--- a/Network/TLS/Util/Serialization.hs
+++ b/Network/TLS/Util/Serialization.hs
@@ -1,6 +1,7 @@
-module Network.TLS.Util.Serialization
-    ( os2ip
-    , i2osp
-    ) where
+module Network.TLS.Util.Serialization (
+    os2ip,
+    i2osp,
+    i2ospOf_,
+) where
 
-import Crypto.Number.Serialize (os2ip, i2osp)
+import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip)
diff --git a/Network/TLS/Wire.hs b/Network/TLS/Wire.hs
--- a/Network/TLS/Wire.hs
+++ b/Network/TLS/Wire.hs
@@ -1,88 +1,89 @@
--- |
--- Module      : Network.TLS.Wire
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- the Wire module is a specialized marshalling/unmarshalling package related to the TLS protocol.
--- all multibytes values are written as big endian.
---
-module Network.TLS.Wire
-    ( Get
-    , GetResult(..)
-    , GetContinuation
-    , runGet
-    , runGetErr
-    , runGetMaybe
-    , tryGet
-    , remaining
-    , getWord8
-    , getWords8
-    , getWord16
-    , getWords16
-    , getWord24
-    , getBytes
-    , getOpaque8
-    , getOpaque16
-    , getOpaque24
-    , getInteger16
-    , getList
-    , processBytes
-    , isEmpty
-    , Put
-    , runPut
-    , putWord8
-    , putWords8
-    , putWord16
-    , putWords16
-    , putWord24
-    , putBytes
-    , putOpaque8
-    , putOpaque16
-    , putOpaque24
-    , putInteger16
-    , encodeWord16
-    , encodeWord64
-    ) where
+-- | The Wire module is a specialized marshalling/unmarshalling
+-- package related to the TLS protocol.  All multibytes values are
+-- written as big endian.
+module Network.TLS.Wire (
+    Get,
+    GetResult (..),
+    GetContinuation,
+    runGet,
+    runGetErr,
+    runGetMaybe,
+    tryGet,
+    remaining,
+    getWord8,
+    getWords8,
+    getWord16,
+    getWords16,
+    getWord24,
+    getWord32,
+    getWord64,
+    getBytes,
+    getOpaque8,
+    getOpaque16,
+    getOpaque24,
+    getInteger16,
+    getBigNum16,
+    getList,
+    processBytes,
+    isEmpty,
+    Put,
+    runPut,
+    putWord8,
+    putWords8,
+    putWord16,
+    putWords16,
+    putWord24,
+    putWord32,
+    putWord64,
+    putBytes,
+    putOpaque8,
+    putOpaque16,
+    putOpaque24,
+    putInteger16,
+    putBigNum16,
+    encodeWord16,
+    encodeWord32,
+    encodeWord64,
+) where
 
+import qualified Data.ByteString as B
 import Data.Serialize.Get hiding (runGet)
 import qualified Data.Serialize.Get as G
 import Data.Serialize.Put
-import Control.Applicative ((<$>))
-import Control.Monad.Error
-import qualified Data.ByteString as B
-import Data.Word
-import Data.Bits
-import Network.TLS.Struct
+
+import Network.TLS.Error
+import Network.TLS.Imports
+import Network.TLS.Types
 import Network.TLS.Util.Serialization
 
-type GetContinuation a = Bytes -> GetResult a
-data GetResult a =
-      GotError TLSError
+type GetContinuation a = ByteString -> GetResult a
+data GetResult a
+    = GotError TLSError
     | GotPartial (GetContinuation a)
     | GotSuccess a
-    | GotSuccessRemaining a Bytes
+    | GotSuccessRemaining a ByteString
 
-runGet :: String -> Get a -> Bytes -> GetResult a
+runGet :: String -> Get a -> ByteString -> GetResult a
 runGet lbl f = toGetResult <$> G.runGetPartial (label lbl f)
-  where toGetResult (G.Fail err _)    = GotError (Error_Packet_Parsing err)
-        toGetResult (G.Partial cont)  = GotPartial (toGetResult <$> cont)
-        toGetResult (G.Done r bsLeft)
-            | B.null bsLeft = GotSuccess r
-            | otherwise     = GotSuccessRemaining r bsLeft
+  where
+    toGetResult (G.Fail err _) = GotError (Error_Packet_Parsing err)
+    toGetResult (G.Partial cont) = GotPartial (toGetResult <$> cont)
+    toGetResult (G.Done r bsLeft)
+        | B.null bsLeft = GotSuccess r
+        | otherwise = GotSuccessRemaining r bsLeft
 
-runGetErr :: String -> Get a -> Bytes -> Either TLSError a
+runGetErr :: String -> Get a -> ByteString -> Either TLSError a
 runGetErr lbl getter b = toSimple $ runGet lbl getter b
-  where toSimple (GotError err) = Left err
-        toSimple (GotPartial _) = Left (Error_Packet_Parsing (lbl ++ ": parsing error: partial packet"))
-        toSimple (GotSuccessRemaining _ _) = Left (Error_Packet_Parsing (lbl ++ ": parsing error: remaining bytes"))
-        toSimple (GotSuccess r) = Right r
+  where
+    toSimple (GotError err) = Left err
+    toSimple (GotPartial _) = Left (Error_Packet_Parsing (lbl ++ ": parsing error: partial packet"))
+    toSimple (GotSuccessRemaining _ _) = Left (Error_Packet_Parsing (lbl ++ ": parsing error: remaining bytes"))
+    toSimple (GotSuccess r) = Right r
 
-runGetMaybe :: Get a -> Bytes -> Maybe a
+runGetMaybe :: Get a -> ByteString -> Maybe a
 runGetMaybe f = either (const Nothing) Just . G.runGet f
 
-tryGet :: Get a -> Bytes -> Maybe a
+tryGet :: Get a -> ByteString -> Maybe a
 tryGet f = either (const Nothing) Just . G.runGet f
 
 getWords8 :: Get [Word8]
@@ -92,7 +93,10 @@
 getWord16 = getWord16be
 
 getWords16 :: Get [Word16]
-getWords16 = getWord16 >>= \lenb -> replicateM (fromIntegral lenb `div` 2) getWord16
+getWords16 = do
+    lenb <- getWord16
+    when (odd lenb) $ fail "length for ciphers must be even"
+    replicateM (fromIntegral lenb `shiftR` 1) getWord16
 
 getWord24 :: Get Int
 getWord24 = do
@@ -101,24 +105,36 @@
     c <- fromIntegral <$> getWord8
     return $ (a `shiftL` 16) .|. (b `shiftL` 8) .|. c
 
-getOpaque8 :: Get Bytes
+getWord32 :: Get Word32
+getWord32 = getWord32be
+
+getWord64 :: Get Word64
+getWord64 = getWord64be
+
+getOpaque8 :: Get ByteString
 getOpaque8 = getWord8 >>= getBytes . fromIntegral
 
-getOpaque16 :: Get Bytes
+getOpaque16 :: Get ByteString
 getOpaque16 = getWord16 >>= getBytes . fromIntegral
 
-getOpaque24 :: Get Bytes
+getOpaque24 :: Get ByteString
 getOpaque24 = getWord24 >>= getBytes
 
 getInteger16 :: Get Integer
 getInteger16 = os2ip <$> getOpaque16
 
-getList :: Int -> (Get (Int, a)) -> Get [a]
+getBigNum16 :: Get BigNum
+getBigNum16 = BigNum <$> getOpaque16
+
+getList :: Int -> Get (Int, a) -> Get [a]
 getList totalLen getElement = isolate totalLen (getElements totalLen)
-  where getElements len
-            | len < 0     = error "list consumed too much data. should never happen with isolate."
-            | len == 0    = return []
-            | otherwise   = getElement >>= \(elementLen, a) -> liftM ((:) a) (getElements (len - elementLen))
+  where
+    getElements len
+        | len < 0 =
+            error "list consumed too much data. should never happen with isolate."
+        | len == 0 = return []
+        | otherwise =
+            getElement >>= \(elementLen, a) -> (:) a <$> getElements (len - elementLen)
 
 processBytes :: Int -> Get a -> Get a
 processBytes i f = isolate i f
@@ -131,9 +147,15 @@
 putWord16 :: Word16 -> Put
 putWord16 = putWord16be
 
+putWord32 :: Word32 -> Put
+putWord32 = putWord32be
+
+putWord64 :: Word64 -> Put
+putWord64 = putWord64be
+
 putWords16 :: [Word16] -> Put
 putWords16 l = do
-    putWord16 $ 2 * (fromIntegral $ length l)
+    putWord16 $ 2 * fromIntegral (length l)
     mapM_ putWord16 l
 
 putWord24 :: Int -> Put
@@ -141,25 +163,31 @@
     let a = fromIntegral ((i `shiftR` 16) .&. 0xff)
     let b = fromIntegral ((i `shiftR` 8) .&. 0xff)
     let c = fromIntegral (i .&. 0xff)
-    mapM_ putWord8 [a,b,c]
+    mapM_ putWord8 [a, b, c]
 
-putBytes :: Bytes -> Put
+putBytes :: ByteString -> Put
 putBytes = putByteString
 
-putOpaque8 :: Bytes -> Put
+putOpaque8 :: ByteString -> Put
 putOpaque8 b = putWord8 (fromIntegral $ B.length b) >> putBytes b
 
-putOpaque16 :: Bytes -> Put
+putOpaque16 :: ByteString -> Put
 putOpaque16 b = putWord16 (fromIntegral $ B.length b) >> putBytes b
 
-putOpaque24 :: Bytes -> Put
+putOpaque24 :: ByteString -> Put
 putOpaque24 b = putWord24 (B.length b) >> putBytes b
 
 putInteger16 :: Integer -> Put
 putInteger16 = putOpaque16 . i2osp
 
-encodeWord16 :: Word16 -> Bytes
+putBigNum16 :: BigNum -> Put
+putBigNum16 (BigNum b) = putOpaque16 b
+
+encodeWord16 :: Word16 -> ByteString
 encodeWord16 = runPut . putWord16
 
-encodeWord64 :: Word64 -> Bytes
+encodeWord32 :: Word32 -> ByteString
+encodeWord32 = runPut . putWord32
+
+encodeWord64 :: Word64 -> ByteString
 encodeWord64 = runPut . putWord64be
diff --git a/Network/TLS/X509.hs b/Network/TLS/X509.hs
--- a/Network/TLS/X509.hs
+++ b/Network/TLS/X509.hs
@@ -1,59 +1,82 @@
--- |
--- Module      : Network.TLS.X509
--- License     : BSD-style
--- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--- Stability   : experimental
--- Portability : unknown
---
--- X509 helpers
---
-module Network.TLS.X509
-    ( CertificateChain(..)
-    , Certificate(..)
-    , SignedCertificate
-    , getCertificate
-    , isNullCertificateChain
-    , getCertificateChainLeaf
-    , CertificateRejectReason(..)
-    , CertificateUsage(..)
-    , CertificateStore
-    , ValidationCache
-    , exceptionValidationCache
-    , validateDefault
-    , FailedReason
-    , ServiceID
-    , wrapCertificateChecks
-    ) where
+-- | X509 helpers
+module Network.TLS.X509 (
+    CertificateChain (..),
+    Certificate (..),
+    SignedCertificate,
+    getCertificate,
+    isNullCertificateChain,
+    getCertificateChainLeaf,
+    CertificateRejectReason (..),
+    CertificateUsage (..),
+    CertificateStore,
+    ValidationCache,
+    defaultValidationCache,
+    exceptionValidationCache,
+    validateDefault,
+    FailedReason,
+    ServiceID,
+    wrapCertificateChecks,
+    pubkeyType,
+    validateClientCertificate,
+) where
 
 import Data.X509
-import Data.X509.Validation
 import Data.X509.CertificateStore
+import Data.X509.Validation
 
 isNullCertificateChain :: CertificateChain -> Bool
 isNullCertificateChain (CertificateChain l) = null l
 
 getCertificateChainLeaf :: CertificateChain -> SignedExact Certificate
-getCertificateChainLeaf (CertificateChain [])    = error "empty certificate chain"
-getCertificateChainLeaf (CertificateChain (x:_)) = x
+getCertificateChainLeaf (CertificateChain []) = error "empty certificate chain"
+getCertificateChainLeaf (CertificateChain (x : _)) = x
 
 -- | Certificate and Chain rejection reason
-data CertificateRejectReason =
-          CertificateRejectExpired
-        | CertificateRejectRevoked
-        | CertificateRejectUnknownCA
-        | CertificateRejectOther String
-        deriving (Show,Eq)
+data CertificateRejectReason
+    = CertificateRejectExpired
+    | CertificateRejectRevoked
+    | CertificateRejectUnknownCA
+    | CertificateRejectAbsent
+    | CertificateRejectOther String
+    deriving (Show, Eq)
 
 -- | Certificate Usage callback possible returns values.
-data CertificateUsage =
-          CertificateUsageAccept                         -- ^ usage of certificate accepted
-        | CertificateUsageReject CertificateRejectReason -- ^ usage of certificate rejected
-        deriving (Show,Eq)
+data CertificateUsage
+    = -- | usage of certificate accepted
+      CertificateUsageAccept
+    | -- | usage of certificate rejected
+      CertificateUsageReject CertificateRejectReason
+    deriving (Show, Eq)
 
 wrapCertificateChecks :: [FailedReason] -> CertificateUsage
 wrapCertificateChecks [] = CertificateUsageAccept
 wrapCertificateChecks l
-    | Expired `elem` l   = CertificateUsageReject $ CertificateRejectExpired
-    | InFuture `elem` l  = CertificateUsageReject $ CertificateRejectExpired
-    | UnknownCA `elem` l = CertificateUsageReject $ CertificateRejectUnknownCA
-    | otherwise          = CertificateUsageReject $ CertificateRejectOther (show l)
+    | Expired `elem` l = CertificateUsageReject CertificateRejectExpired
+    | InFuture `elem` l = CertificateUsageReject CertificateRejectExpired
+    | UnknownCA `elem` l = CertificateUsageReject CertificateRejectUnknownCA
+    | SelfSigned `elem` l = CertificateUsageReject CertificateRejectUnknownCA
+    | EmptyChain `elem` l = CertificateUsageReject CertificateRejectAbsent
+    | otherwise = CertificateUsageReject $ CertificateRejectOther (show l)
+
+pubkeyType :: PubKey -> String
+pubkeyType = show . pubkeyToAlg
+
+-- | A utility function for client authentication which can be used
+-- `onClientCertificate`.
+--
+-- Since: 2.1.7
+validateClientCertificate
+    :: CertificateStore
+    -> ValidationCache
+    -> CertificateChain
+    -> IO CertificateUsage
+validateClientCertificate store cache cc =
+    wrapCertificateChecks
+        <$> validate
+            HashSHA256
+            defaultHooks
+            defaultChecks{checkFQHN = False}
+            store
+            cache
+            ("", mempty)
+            cc
diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,2 +1,3 @@
 import Distribution.Simple
+
 main = defaultMain
diff --git a/Tests/Certificate.hs b/Tests/Certificate.hs
deleted file mode 100644
--- a/Tests/Certificate.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-module Certificate
-    ( arbitraryX509
-    , arbitraryX509WithKey
-    , simpleCertificate
-    , simpleX509
-    ) where
-
-import Test.QuickCheck
-import Data.X509
-import Data.Time.Calendar (fromGregorian)
-import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
-import qualified Data.ByteString as B
-
-import PubKey
-
-testExtensionEncode critical ext = ExtensionRaw (extOID ext) critical (extEncode ext)
-
-arbitraryDN = return $ DistinguishedName []
-
-arbitraryTime = do
-    year   <- choose (1951, 2050)
-    month  <- choose (1, 12)
-    day    <- choose (1, 30)
-    hour   <- choose (0, 23)
-    minute <- choose (0, 59)
-    second <- choose (0, 59)
-    --z      <- arbitrary
-    return $ UTCTime (fromGregorian year month day) (secondsToDiffTime (hour * 3600 + minute * 60 + second))
-
-maxSerial = 16777216
-
-arbitraryCertificate pubKey = do
-    serial    <- choose (0,maxSerial)
-    issuerdn  <- arbitraryDN
-    subjectdn <- arbitraryDN
-    time1     <- arbitraryTime
-    time2     <- arbitraryTime
-    let sigalg = SignatureALG HashSHA1 (pubkeyToAlg pubKey)
-    return $ Certificate
-            { certVersion      = 3
-            , certSerial       = serial
-            , certSignatureAlg = sigalg
-            , certIssuerDN     = issuerdn
-            , certSubjectDN    = subjectdn
-            , certValidity     = (time1, time2)
-            , certPubKey       = pubKey
-            , certExtensions   = Extensions $ Just
-                [ testExtensionEncode True $ ExtKeyUsage [KeyUsage_digitalSignature,KeyUsage_keyEncipherment,KeyUsage_keyCertSign]
-                ]
-            }
-
-simpleCertificate pubKey =
-    Certificate
-        { certVersion = 3
-        , certSerial = 0
-        , certSignatureAlg = SignatureALG HashSHA1 (pubkeyToAlg pubKey)
-        , certIssuerDN     = simpleDN
-        , certSubjectDN    = simpleDN
-        , certValidity     = (time1, time2)
-        , certPubKey       = pubKey
-        , certExtensions   = Extensions $ Just
-                [ testExtensionEncode True $ ExtKeyUsage [KeyUsage_digitalSignature,KeyUsage_keyEncipherment]
-                ]
-        }
-  where time1 = UTCTime (fromGregorian 1999 1 1) 0
-        time2 = UTCTime (fromGregorian 2901 1 1) 0
-        simpleDN = DistinguishedName []
-
-simpleX509 pubKey = do
-    let cert = simpleCertificate pubKey
-        sig  = replicate 40 1
-        sigalg = SignatureALG HashSHA1 (pubkeyToAlg pubKey)
-        (signedExact, ()) = objectToSignedExact (\_ -> (B.pack sig,sigalg,())) cert
-     in signedExact
-
-arbitraryX509WithKey (pubKey, _) = do
-    cert <- arbitraryCertificate pubKey
-    sig  <- resize 40 $ listOf1 arbitrary
-    let sigalg = SignatureALG HashSHA1 (pubkeyToAlg pubKey)
-    let (signedExact, ()) = objectToSignedExact (\(!(_)) -> (B.pack sig,sigalg,())) cert
-    return signedExact
-
-arbitraryX509 = do
-    let (pubKey, privKey) = getGlobalRSAPair
-    arbitraryX509WithKey (PubKeyRSA pubKey, PrivKeyRSA privKey)
diff --git a/Tests/Ciphers.hs b/Tests/Ciphers.hs
deleted file mode 100644
--- a/Tests/Ciphers.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-module Ciphers
-    ( propertyBulkFunctional
-    ) where
-
-import Control.Applicative ((<$>), (<*>))
-
-import Test.QuickCheck
-
-import qualified Data.ByteString as B
-import Network.TLS.Cipher
-import Network.TLS.Extra.Cipher
-
-arbitraryKey :: Bulk -> Gen B.ByteString
-arbitraryKey bulk = B.pack `fmap` vector (fromIntegral $ bulkKeySize bulk)
-
-arbitraryIV :: Bulk -> Gen B.ByteString
-arbitraryIV bulk = B.pack `fmap` vector (fromIntegral $ bulkIVSize bulk)
-
-arbitraryText :: Bulk -> Gen B.ByteString
-arbitraryText bulk = B.pack `fmap` vector (fromIntegral $ bulkBlockSize bulk)
-
-data BulkTest = BulkTest Bulk B.ByteString B.ByteString B.ByteString
-    deriving (Show,Eq)
-
-instance Arbitrary BulkTest where
-    arbitrary = do
-        bulk <- cipherBulk `fmap` elements ciphersuite_all
-        BulkTest bulk <$> arbitraryKey bulk <*> arbitraryIV bulk <*> arbitraryText bulk
-
-propertyBulkFunctional :: BulkTest -> Bool
-propertyBulkFunctional (BulkTest bulk key iv t) =
-    case bulkF bulk of
-        BulkBlockF enc dec       -> block enc dec
-        BulkStreamF ktoi enc dec -> stream ktoi enc dec
-  where
-        block e d = (d key iv . e key iv) t == t
-        stream ktoi e d = (fst . d siv . fst . e siv) t == t
-            where siv = ktoi key
diff --git a/Tests/Connection.hs b/Tests/Connection.hs
deleted file mode 100644
--- a/Tests/Connection.hs
+++ /dev/null
@@ -1,166 +0,0 @@
-module Connection
-    ( newPairContext
-    , arbitraryPairParams
-    , setPairParamsSessionManager
-    , setPairParamsSessionResuming
-    , establishDataPipe
-    , blockCipher
-    , streamCipher
-    ) where
-
-import Test.QuickCheck
-import Certificate
-import PubKey
-import PipeChan
-import Network.TLS
-import Data.X509
-import Data.Default.Class
-import Control.Applicative
-import Control.Concurrent.Chan
-import Control.Concurrent
-import qualified Control.Exception as E
-
-import qualified Crypto.Random.AESCtr as RNG
-import qualified Data.ByteString as B
-
-debug = False
-
-blockCipher :: Cipher
-blockCipher = Cipher
-    { cipherID   = 0xff12
-    , cipherName = "rsa-id-const"
-    , cipherBulk = Bulk
-        { bulkName      = "id"
-        , bulkKeySize   = 16
-        , bulkIVSize    = 16
-        , bulkBlockSize = 16
-        , bulkF         = BulkBlockF (\_ _ m -> m) (\_ _ m -> m)
-        }
-    , cipherHash = Hash
-        { hashName = "const-hash"
-        , hashSize = 16
-        , hashF    = (\_ -> B.replicate 16 1)
-        }
-    , cipherKeyExchange = CipherKeyExchange_RSA
-    , cipherMinVer      = Nothing
-    }
-
-blockCipherDHE_RSA :: Cipher
-blockCipherDHE_RSA = blockCipher
-    { cipherID   = 0xff14
-    , cipherName = "dhe-rsa-id-const"
-    , cipherKeyExchange = CipherKeyExchange_DHE_RSA
-    }
-
-blockCipherDHE_DSS :: Cipher
-blockCipherDHE_DSS = blockCipher
-    { cipherID   = 0xff15
-    , cipherName = "dhe-dss-id-const"
-    , cipherKeyExchange = CipherKeyExchange_DHE_DSS
-    }
-
-streamCipher :: Cipher
-streamCipher = blockCipher
-    { cipherID   = 0xff13
-    , cipherBulk = Bulk
-        { bulkName      = "stream"
-        , bulkKeySize   = 16
-        , bulkIVSize    = 0
-        , bulkBlockSize = 0
-        , bulkF         = BulkStreamF (\k -> k) (\i m -> (m,i)) (\i m -> (m,i))
-        }
-    }
-
-knownCiphers :: [Cipher]
-knownCiphers = [blockCipher,blockCipherDHE_RSA,blockCipherDHE_DSS,streamCipher]
-
-knownVersions :: [Version]
-knownVersions = [SSL3,TLS10,TLS11,TLS12]
-
-arbitraryPairParams = do
-    (dsaPub, dsaPriv) <- (\(p,r) -> (PubKeyDSA p, PrivKeyDSA r)) <$> arbitraryDSAPair
-    let (pubKey, privKey) = (\(p, r) -> (PubKeyRSA p, PrivKeyRSA r)) $ getGlobalRSAPair
-    creds              <- mapM (\(pub, priv) -> do
-                                    cert <- arbitraryX509WithKey (pub, priv)
-                                    return (CertificateChain [cert], priv)
-                               ) [ (pubKey, privKey), (dsaPub, dsaPriv) ]
-    connectVersion     <- elements knownVersions
-    let allowedVersions = [ v | v <- knownVersions, v <= connectVersion ]
-    serAllowedVersions <- (:[]) `fmap` elements allowedVersions
-    serverCiphers      <- arbitraryCiphers
-    clientCiphers      <- oneof [arbitraryCiphers] `suchThat` (\cs -> or [x `elem` serverCiphers | x <- cs])
-    secNeg             <- arbitrary
-
-
-    let serverState = def
-            { serverSupported = def { supportedCiphers  = serverCiphers
-                                    , supportedVersions = serAllowedVersions
-                                    , supportedSecureRenegotiation = secNeg
-                                    }
-            , serverDHEParams = Just dhParams
-            , serverShared = def { sharedCredentials = Credentials creds }
-            }
-    let clientState = (defaultParamsClient "" B.empty)
-            { clientSupported = def { supportedCiphers  = clientCiphers
-                                    , supportedVersions = allowedVersions
-                                    , supportedSecureRenegotiation = secNeg
-                                    }
-            , clientShared = def { sharedValidationCache = ValidationCache
-                                        { cacheAdd = \_ _ _ -> return ()
-                                        , cacheQuery = \_ _ _ -> return ValidationCachePass
-                                        }
-                                }
-            }
-    return (clientState, serverState)
-  where
-        arbitraryCiphers  = resize (length knownCiphers + 1) $ listOf1 (elements knownCiphers)
-
-setPairParamsSessionManager :: SessionManager -> (ClientParams, ServerParams) -> (ClientParams, ServerParams)
-setPairParamsSessionManager manager (clientState, serverState) = (nc,ns)
-  where nc = clientState { clientShared = updateSessionManager $ clientShared clientState }
-        ns = serverState { serverShared = updateSessionManager $ serverShared serverState }
-        updateSessionManager shared = shared { sharedSessionManager = manager }
-
-setPairParamsSessionResuming sessionStuff (clientState, serverState) =
-    ( clientState { clientWantSessionResume = Just sessionStuff }
-    , serverState)
-
-newPairContext pipe (cParams, sParams) = do
-    let noFlush = return ()
-    let noClose = return ()
-
-    cRNG <- RNG.makeSystem
-    sRNG <- RNG.makeSystem
-
-    let cBackend = Backend noFlush noClose (writePipeA pipe) (readPipeA pipe)
-    let sBackend = Backend noFlush noClose (writePipeB pipe) (readPipeB pipe)
-    cCtx' <- contextNew cBackend cParams cRNG
-    sCtx' <- contextNew sBackend sParams sRNG
-
-    contextHookSetLogging cCtx' (logging "client: ")
-    contextHookSetLogging sCtx' (logging "server: ")
-
-    return (cCtx', sCtx')
-  where
-        logging pre =
-            if debug
-                then def { loggingPacketSent = putStrLn . ((pre ++ ">> ") ++)
-                                    , loggingPacketRecv = putStrLn . ((pre ++ "<< ") ++) }
-                else def
-
-establishDataPipe params tlsServer tlsClient = do
-    -- initial setup
-    pipe        <- newPipe
-    _           <- (runPipe pipe)
-    startQueue  <- newChan
-    resultQueue <- newChan
-
-    (cCtx, sCtx) <- newPairContext pipe params
-
-    _ <- forkIO $ E.catch (tlsServer sCtx resultQueue) (printAndRaise "server")
-    _ <- forkIO $ E.catch (tlsClient startQueue cCtx) (printAndRaise "client")
-
-    return (startQueue, resultQueue)
-  where
-        printAndRaise :: String -> E.SomeException -> IO ()
-        printAndRaise s e = putStrLn (s ++ " exception: " ++ show e) >> E.throw e
diff --git a/Tests/Marshalling.hs b/Tests/Marshalling.hs
deleted file mode 100644
--- a/Tests/Marshalling.hs
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# LANGUAGE CPP #-}
-module Marshalling where
-
-import Control.Monad
-import Control.Applicative
-import Test.QuickCheck
-import Network.TLS.Internal
-import Network.TLS
-
-import qualified Data.ByteString as B
-import Data.Word
-import Data.X509
-import Certificate
-
-genByteString :: Int -> Gen B.ByteString
-genByteString i = B.pack <$> vector i
-
-instance Arbitrary Version where
-    arbitrary = elements [ SSL2, SSL3, TLS10, TLS11, TLS12 ]
-
-instance Arbitrary ProtocolType where
-    arbitrary = elements
-            [ ProtocolType_ChangeCipherSpec
-            , ProtocolType_Alert
-            , ProtocolType_Handshake
-            , ProtocolType_AppData ]
-
-#if MIN_VERSION_QuickCheck(2,3,0)
-#else
-instance Arbitrary Word8 where
-    arbitrary = fromIntegral <$> (choose (0,255) :: Gen Int)
-
-instance Arbitrary Word16 where
-    arbitrary = fromIntegral <$> (choose (0,65535) :: Gen Int)
-#endif
-
-instance Arbitrary Header where
-    arbitrary = Header <$> arbitrary <*> arbitrary <*> arbitrary
-
-instance Arbitrary ClientRandom where
-    arbitrary = ClientRandom <$> (genByteString 32)
-
-instance Arbitrary ServerRandom where
-    arbitrary = ServerRandom <$> (genByteString 32)
-
-instance Arbitrary Session where
-    arbitrary = do
-        i <- choose (1,2) :: Gen Int
-        case i of
-            2 -> liftM (Session . Just) (genByteString 32)
-            _ -> return $ Session Nothing
-
-instance Arbitrary DigitallySigned where
-    arbitrary = DigitallySigned Nothing <$> genByteString 32
-
-arbitraryCiphersIDs :: Gen [Word16]
-arbitraryCiphersIDs = choose (0,200) >>= vector
-
-arbitraryCompressionIDs :: Gen [Word8]
-arbitraryCompressionIDs = choose (0,200) >>= vector
-
-someWords8 :: Int -> Gen [Word8]
-someWords8 i = replicateM i (fromIntegral <$> (choose (0,255) :: Gen Int))
-
-instance Arbitrary CertificateType where
-    arbitrary = elements
-            [ CertificateType_RSA_Sign, CertificateType_DSS_Sign
-            , CertificateType_RSA_Fixed_DH, CertificateType_DSS_Fixed_DH
-            , CertificateType_RSA_Ephemeral_DH, CertificateType_DSS_Ephemeral_DH
-            , CertificateType_fortezza_dms ]
-
-instance Arbitrary Handshake where
-    arbitrary = oneof
-            [ ClientHello
-                <$> arbitrary
-                <*> arbitrary
-                <*> arbitrary
-                <*> arbitraryCiphersIDs
-                <*> arbitraryCompressionIDs
-                <*> (return [])
-                <*> (return Nothing)
-            , ServerHello
-                <$> arbitrary
-                <*> arbitrary
-                <*> arbitrary
-                <*> arbitrary
-                <*> arbitrary
-                <*> (return [])
-            , liftM Certificates (CertificateChain <$> (resize 2 $ listOf $ arbitraryX509))
-            , pure HelloRequest
-            , pure ServerHelloDone
-            , ClientKeyXchg . CKX_RSA <$> genByteString 48
-            --, liftM  ServerKeyXchg
-            , liftM3 CertRequest arbitrary (return Nothing) (return [])
-            , CertVerify <$> arbitrary
-            , Finished <$> (genByteString 12)
-            ]
-
-{- quickcheck property -}
-
-prop_header_marshalling_id :: Header -> Bool
-prop_header_marshalling_id x = (decodeHeader $ encodeHeader x) == Right x
-
-prop_handshake_marshalling_id :: Handshake -> Bool
-prop_handshake_marshalling_id x = (decodeHs $ encodeHandshake x) == Right x
-  where decodeHs b = case decodeHandshakeRecord b of
-                        GotPartial _ -> error "got partial"
-                        GotError e   -> error ("got error: " ++ show e)
-                        GotSuccessRemaining _ _ -> error "got remaining byte left"
-                        GotSuccess (ty, content) -> decodeHandshake cp ty content
-        cp = CurrentParams { cParamsVersion = TLS10, cParamsKeyXchgType = Just CipherKeyExchange_RSA, cParamsSupportNPN = True }
diff --git a/Tests/PipeChan.hs b/Tests/PipeChan.hs
deleted file mode 100644
--- a/Tests/PipeChan.hs
+++ /dev/null
@@ -1,56 +0,0 @@
--- create a similar concept than a unix pipe.
-module PipeChan
-    ( PipeChan(..)
-    , newPipe
-    , runPipe
-    , readPipeA
-    , readPipeB
-    , writePipeA
-    , writePipeB
-    ) where
-
-import Control.Applicative
-import Control.Concurrent.Chan
-import Control.Concurrent
-import Control.Monad (forever)
-import Data.ByteString (ByteString)
-import Data.IORef
-import qualified Data.ByteString as B
-
--- | represent a unidirectional pipe with a buffered read channel and a write channel
-data UniPipeChan = UniPipeChan (Chan ByteString) (Chan ByteString)
-
-newUniPipeChan = UniPipeChan <$> newChan <*> newChan
-
-runUniPipe (UniPipeChan r w) = forkIO $ forever $ readChan r >>= writeChan w
-
-getReadUniPipe (UniPipeChan r _)  = r
-getWriteUniPipe (UniPipeChan _ w) = w
-
--- | Represent a bidirectional pipe with 2 nodes A and B
-data PipeChan = PipeChan (IORef ByteString) (IORef ByteString) UniPipeChan UniPipeChan
-
-newPipe = PipeChan <$> newIORef B.empty <*> newIORef B.empty <*> newUniPipeChan <*> newUniPipeChan
-
-runPipe (PipeChan _ _ cToS sToC) = runUniPipe cToS >> runUniPipe sToC
-
-readPipeA (PipeChan _ b _ s) sz = readBuffered b (getWriteUniPipe s) sz
-writePipeA (PipeChan _ _ c _)   = writeChan $ getWriteUniPipe c
-
-readPipeB (PipeChan b _ c _) sz = readBuffered b (getWriteUniPipe c) sz
-writePipeB (PipeChan _ _ _ s)   = writeChan $ getReadUniPipe s
-
--- helper to read buffered data.
-readBuffered buf chan sz = do
-    left <- readIORef buf
-    if B.length left >= sz
-        then do
-            let (ret, nleft) = B.splitAt sz left
-            writeIORef buf nleft
-            return ret
-        else do
-            let newSize = (sz - B.length left)
-            newData <- readChan chan
-            writeIORef buf newData
-            remain <- readBuffered buf chan newSize
-            return (left `B.append` remain)
diff --git a/Tests/PubKey.hs b/Tests/PubKey.hs
deleted file mode 100644
--- a/Tests/PubKey.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-module PubKey
-    ( arbitraryRSAPair
-    , arbitraryDSAPair
-    , globalRSAPair
-    , getGlobalRSAPair
-    , dhParams
-    , dsaParams
-    , rsaParams
-    ) where
-
-import Test.QuickCheck
-
-import qualified Crypto.PubKey.DH as DH
-import Crypto.Random (createTestEntropyPool)
-import qualified Crypto.Random.AESCtr as RNG
-import qualified Crypto.PubKey.RSA as RSA
-import qualified Crypto.PubKey.DSA as DSA
-
-import qualified Data.ByteString as B
-
-import Control.Concurrent.MVar
-import System.IO.Unsafe
-
-arbitraryRSAPair :: Gen (RSA.PublicKey, RSA.PrivateKey)
-arbitraryRSAPair = do
-    rng <- (RNG.make . createTestEntropyPool . B.pack) `fmap` vector 1024
-    arbitraryRSAPairWithRNG rng
-
-arbitraryRSAPairWithRNG rng = return $ fst $ RSA.generate rng 128 0x10001
-
-{-# NOINLINE globalRSAPair #-}
-globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)
-globalRSAPair = unsafePerformIO (RNG.makeSystem >>= arbitraryRSAPairWithRNG >>= newMVar)
-
-{-# NOINLINE getGlobalRSAPair #-}
-getGlobalRSAPair :: (RSA.PublicKey, RSA.PrivateKey)
-getGlobalRSAPair = unsafePerformIO (readMVar globalRSAPair)
-
-rsaParams :: (RSA.PublicKey, RSA.PrivateKey)
-rsaParams = (pub, priv)
- where priv = RSA.PrivateKey { RSA.private_pub  = pub
-                             , RSA.private_d    = d
-                             , RSA.private_p    = 0
-                             , RSA.private_q    = 0
-                             , RSA.private_dP   = 0
-                             , RSA.private_dQ   = 0
-                             , RSA.private_qinv = 0
-                             }
-       pub = RSA.PublicKey { RSA.public_size = (1024 `div` 8), RSA.public_n = n, RSA.public_e = e }
-       n = 0x00c086b4c6db28ae578d73766d6fdd04b913808a85bf9ad7bcfc9a6ff04d13d2ff75f761ce7db9ee8996e29dc433d19a2d3f748e8d368ba099781d58276e1863a324ae3fb1a061874cd9f3510e54e49727c68de0616964335371cfb63f15ebff8ce8df09c74fb8625f8f58548b90f079a3405f522e738e664d0c645b015664f7c7
-       e = 0x10001
-       d = 0x3edc3cae28e4717818b1385ba7088d0038c3e176a606d2a5dbfc38cc46fe500824e62ec312fde04a803f61afac13a5b95c5c9c26b346879b54429083df488b4f29bb7b9722d366d6f5d2b512150a2e950eacfe0fd9dd56b87b0322f74ae3c8d8674ace62bc723f7c05e9295561efd70d7a924c6abac2e482880fc0149d5ad481
-
-dhParams :: DH.Params
-dhParams = DH.Params
-    { DH.params_p = 0x00ccaa3884b50789ebea8d39bef8bbc66e20f2a78f537a76f26b4edde5de8b0ff15a8193abf0873cbdc701323a2bf6e860affa6e043fe8300d47e95baf9f6354cb
-    , DH.params_g = 0x2
-    }
-
-dsaParams :: DSA.Params
-dsaParams = DSA.Params
-    { DSA.params_p = 0x009f356bbc4750645555b02aa3918e85d5e35bdccd56154bfaa3e1801d5fe0faf65355215148ea866d5732fd27eb2f4d222c975767d2eb573513e460eceae327c8ac5da1f4ce765c49a39cae4c904b4e5cc64554d97148f20a2655027a0cf8f70b2550cc1f0c9861ce3a316520ab0588407ea3189d20c78bd52df97e56cbe0bbeb
-    , DSA.params_q = 0x00f33a57b47de86ff836f9fe0bb060c54ab293133b
-    , DSA.params_g = 0x3bb973c4f6eee92d1530f250487735595d778c2e5c8147d67a46ebcba4e6444350d49da8e7da667f9b1dbb22d2108870b9fcfabc353cdfac5218d829f22f69130317cc3b0d724881e34c34b8a2571d411da6458ef4c718df9e826f73e16a035b1dcbc1c62cac7a6604adb3e7930be8257944c6dfdddd655004b98253185775ff
-    }
-
-arbitraryDSAPair :: Gen (DSA.PublicKey, DSA.PrivateKey)
-arbitraryDSAPair = do
-    priv <- choose (1, DSA.params_q dsaParams)
-    let pub = DSA.calculatePublic dsaParams priv
-    return (DSA.PublicKey dsaParams pub, DSA.PrivateKey dsaParams priv)
diff --git a/Tests/Tests.hs b/Tests/Tests.hs
deleted file mode 100644
--- a/Tests/Tests.hs
+++ /dev/null
@@ -1,182 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-import Test.QuickCheck
-import Test.QuickCheck.Monadic
-import Test.Framework (defaultMain, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-
-import PipeChan
-import Connection
-import Marshalling
-import Ciphers
-
-import Data.Maybe
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as C8
-import qualified Data.ByteString.Lazy as L
-import Network.TLS
-import Control.Applicative
-import Control.Concurrent
-import Control.Monad
-
-import Data.IORef
-
-prop_pipe_work :: PropertyM IO ()
-prop_pipe_work = do
-    pipe <- run newPipe
-    _ <- run (runPipe pipe)
-
-    let bSize = 16
-    n <- pick (choose (1, 32))
-
-    let d1 = B.replicate (bSize * n) 40
-    let d2 = B.replicate (bSize * n) 45
-
-    d1' <- run (writePipeA pipe d1 >> readPipeB pipe (B.length d1))
-    d1 `assertEq` d1'
-
-    d2' <- run (writePipeB pipe d2 >> readPipeA pipe (B.length d2))
-    d2 `assertEq` d2'
-
-    return ()
-
-recvDataNonNull ctx = recvData ctx >>= \l -> if B.null l then recvDataNonNull ctx else return l
-
-runTLSPipe params tlsServer tlsClient = do
-    (startQueue, resultQueue) <- run (establishDataPipe params tlsServer tlsClient)
-    -- send some data
-    d <- B.pack <$> pick (someWords8 256)
-    run $ writeChan startQueue d
-    -- receive it
-    dres <- run $ readChan resultQueue
-    -- check if it equal
-    d `assertEq` dres
-    return ()
-
-prop_handshake_initiate :: PropertyM IO ()
-prop_handshake_initiate = do
-    params  <- pick arbitraryPairParams
-    runTLSPipe params tlsServer tlsClient
-  where tlsServer ctx queue = do
-            handshake ctx
-            d <- recvDataNonNull ctx
-            writeChan queue d
-            return ()
-        tlsClient queue ctx = do
-            handshake ctx
-            d <- readChan queue
-            sendData ctx (L.fromChunks [d])
-            bye ctx
-            return ()
-
-prop_handshake_npn_initiate :: PropertyM IO ()
-prop_handshake_npn_initiate = do
-    (clientParam,serverParam) <- pick arbitraryPairParams
-    let clientParam' = clientParam { clientHooks = (clientHooks clientParam)
-                                       { onNPNServerSuggest = Just $ \protos -> return (head protos) }
-                                    }
-        serverParam' = serverParam { serverHooks = (serverHooks serverParam)
-                                        { onSuggestNextProtocols = return $ Just [C8.pack "spdy/2", C8.pack "http/1.1"] }
-                                   }
-        params' = (clientParam',serverParam')
-    runTLSPipe params' tlsServer tlsClient
-  where tlsServer ctx queue = do
-            handshake ctx
-            proto <- getNegotiatedProtocol ctx
-            Just (C8.pack "spdy/2") `assertEq` proto
-            d <- recvDataNonNull ctx
-            writeChan queue d
-            return ()
-        tlsClient queue ctx = do
-            handshake ctx
-            proto <- getNegotiatedProtocol ctx
-            Just (C8.pack "spdy/2") `assertEq` proto
-            d <- readChan queue
-            sendData ctx (L.fromChunks [d])
-            bye ctx
-            return ()
-
-prop_handshake_renegociation :: PropertyM IO ()
-prop_handshake_renegociation = do
-    params <- pick arbitraryPairParams
-    runTLSPipe params tlsServer tlsClient
-  where tlsServer ctx queue = do
-            handshake ctx
-            d <- recvDataNonNull ctx
-            writeChan queue d
-            return ()
-        tlsClient queue ctx = do
-            handshake ctx
-            handshake ctx
-            d <- readChan queue
-            sendData ctx (L.fromChunks [d])
-            bye ctx
-            return ()
-
--- | simple session manager to store one session id and session data for a single thread.
--- a Real concurrent session manager would use an MVar and have multiples items.
-oneSessionManager :: IORef (Maybe (SessionID, SessionData)) -> SessionManager
-oneSessionManager ref = SessionManager
-    { sessionResume     = \myId     -> (>>= maybeResume myId) <$> readIORef ref
-    , sessionEstablish  = \myId dat -> writeIORef ref $ Just (myId, dat)
-    , sessionInvalidate = \_        -> return ()
-    }
-  where
-    maybeResume myId (sid, sdata)
-        | sid == myId = Just sdata
-        | otherwise   = Nothing
-
-prop_handshake_session_resumption :: PropertyM IO ()
-prop_handshake_session_resumption = do
-    sessionRef <- run $ newIORef Nothing
-    let sessionManager = oneSessionManager sessionRef
-
-    plainParams <- pick arbitraryPairParams
-    let params = setPairParamsSessionManager sessionManager plainParams
-
-    runTLSPipe params tlsServer tlsClient
-
-    -- and resume
-    sessionParams <- run $ readIORef sessionRef
-    assert (isJust sessionParams)
-    let params2 = setPairParamsSessionResuming (fromJust sessionParams) params
-
-    runTLSPipe params2 tlsServer tlsClient
-  where tlsServer ctx queue = do
-            handshake ctx
-            d <- recvDataNonNull ctx
-            writeChan queue d
-            return ()
-        tlsClient queue ctx = do
-            handshake ctx
-            d <- readChan queue
-            sendData ctx (L.fromChunks [d])
-            bye ctx
-            return ()
-
-assertEq :: (Show a, Monad m, Eq a) => a -> a -> m ()
-assertEq expected got = unless (expected == got) $ error ("got " ++ show got ++ " but was expecting " ++ show expected)
-
-main :: IO ()
-main = defaultMain
-    [ tests_marshalling
-    , tests_ciphers
-    , tests_handshake
-    ]
-  where -- lowlevel tests to check the packet marshalling.
-        tests_marshalling = testGroup "Marshalling"
-            [ testProperty "Header" prop_header_marshalling_id
-            , testProperty "Handshake" prop_handshake_marshalling_id
-            ]
-        tests_ciphers = testGroup "Ciphers"
-            [ testProperty "Bulk" propertyBulkFunctional ]
-
-        -- high level tests between a client and server with fake ciphers.
-        tests_handshake = testGroup "Handshakes"
-            [ testProperty "setup" (monadicIO prop_pipe_work)
-            , testProperty "initiate" (monadicIO prop_handshake_initiate)
-            , testProperty "npnInitiate" (monadicIO prop_handshake_npn_initiate)
-            , testProperty "renegociation" (monadicIO prop_handshake_renegociation)
-            , testProperty "resumption" (monadicIO prop_handshake_session_resumption)
-            ]
diff --git a/test/API.hs b/test/API.hs
new file mode 100644
--- /dev/null
+++ b/test/API.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module API where
+
+import Control.Applicative
+import Control.Monad
+import Data.ByteString (ByteString)
+import Data.Maybe
+import Network.TLS
+import Test.Hspec
+
+checkCtxFinished :: Context -> IO ()
+checkCtxFinished ctx = do
+    mUnique <- getTLSUnique ctx
+    mExporter <- getTLSExporter ctx
+    when (isNothing (mUnique <|> mExporter)) $
+        fail "unexpected channel binding"
+
+recvDataAssert :: Context -> ByteString -> IO ()
+recvDataAssert ctx expected = do
+    got <- recvData ctx
+    got `shouldBe` expected
diff --git a/test/Arbitrary.hs b/test/Arbitrary.hs
new file mode 100644
--- /dev/null
+++ b/test/Arbitrary.hs
@@ -0,0 +1,452 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Arbitrary where
+
+import Control.Monad
+import qualified Data.ByteString as B
+import Data.List
+import Data.Word
+import Data.X509 (ExtKeyUsageFlag)
+import Network.TLS
+import Network.TLS.Extra.Cipher
+import Network.TLS.Internal
+import Test.QuickCheck
+
+import Certificate
+import PubKey
+
+----------------------------------------------------------------
+
+instance Arbitrary Version where
+    arbitrary = elements [TLS12, TLS13]
+
+instance Arbitrary ProtocolType where
+    arbitrary =
+        elements
+            [ ProtocolType_ChangeCipherSpec
+            , ProtocolType_Alert
+            , ProtocolType_Handshake
+            , ProtocolType_AppData
+            ]
+
+instance Arbitrary Header where
+    arbitrary = Header <$> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary ClientRandom where
+    arbitrary = ClientRandom <$> genByteString 32
+
+instance Arbitrary ServerRandom where
+    arbitrary = ServerRandom <$> genByteString 32
+
+instance Arbitrary Session where
+    arbitrary = do
+        i <- choose (1, 2) :: Gen Int
+        case i of
+            2 -> Session . Just <$> genByteString 32
+            _ -> return $ Session Nothing
+
+instance {-# OVERLAPS #-} Arbitrary [HashAndSignatureAlgorithm] where
+    arbitrary = shuffle supportedSignatureSchemes
+
+instance Arbitrary DigitallySigned where
+    arbitrary = DigitallySigned . unsafeHead <$> arbitrary <*> genByteString 32
+
+instance Arbitrary ExtensionRaw where
+    arbitrary =
+        let arbitraryContent = choose (0, 40) >>= genByteString
+         in ExtensionRaw . ExtensionID <$> arbitrary <*> arbitraryContent
+
+instance Arbitrary CertificateType where
+    arbitrary =
+        elements
+            [ CertificateType_RSA_Sign
+            , CertificateType_DSA_Sign
+            , CertificateType_ECDSA_Sign
+            ]
+
+instance Arbitrary CipherId where
+    arbitrary = CipherId <$> arbitrary
+
+instance Arbitrary Handshake where
+    arbitrary =
+        oneof
+            [ arbitrary >>= \ver -> do
+                ClientHello
+                    <$> ( CH ver
+                            <$> arbitrary
+                            <*> arbitrary
+                            <*> arbitraryCiphersIds
+                            <*> arbitraryCompressionIDs
+                            <*> arbitraryHelloExtensions ver
+                        )
+            , arbitrary >>= \ver ->
+                ServerHello
+                    <$> ( SH ver
+                            <$> arbitrary
+                            <*> arbitrary
+                            <*> arbitrary
+                            <*> arbitrary
+                            <*> arbitraryHelloExtensions ver
+                        )
+            , Certificate . CertificateChain_ . CertificateChain
+                <$> resize 2 (listOf arbitraryX509)
+            , pure HelloRequest
+            , pure ServerHelloDone
+            , ClientKeyXchg . CKX_RSA <$> genByteString 48
+            , CertRequest <$> arbitrary <*> arbitrary <*> listOf arbitraryDN
+            , CertVerify <$> arbitrary
+            , Finished . VerifyData <$> genByteString 12
+            ]
+
+instance Arbitrary Handshake13 where
+    arbitrary =
+        oneof
+            [ arbitrary >>= \ver ->
+                ServerHello13
+                    <$> ( SH TLS12
+                            <$> arbitrary
+                            <*> arbitrary
+                            <*> arbitrary
+                            <*> pure 0
+                            <*> arbitraryHelloExtensions ver
+                        )
+            , NewSessionTicket13
+                <$> arbitrary
+                <*> arbitrary
+                <*> (TicketNonce <$> genByteString 32) -- nonce
+                <*> (SessionIDorTicket_ <$> genByteString 32) -- session ID
+                <*> arbitrary
+            , pure EndOfEarlyData13
+            , EncryptedExtensions13 <$> arbitrary
+            , CertRequest13
+                <$> arbitraryCertReqContext
+                <*> arbitrary
+            , resize 2 (listOf arbitraryX509) >>= \certs ->
+                Certificate13
+                    <$> arbitraryCertReqContext
+                    <*> return (CertificateChain_ (CertificateChain certs))
+                    <*> replicateM (length certs) arbitrary
+            , CertVerify13
+                <$> ( DigitallySigned . unsafeHead
+                        <$> arbitrary
+                        <*> genByteString 32
+                    )
+            , Finished13 . VerifyData <$> genByteString 12
+            , KeyUpdate13 <$> elements [UpdateNotRequested, UpdateRequested]
+            ]
+
+----------------------------------------------------------------
+
+arbitraryCiphersIds :: Gen [CipherId]
+arbitraryCiphersIds = map CipherId <$> (choose (0, 200) >>= vector)
+
+arbitraryCompressionIDs :: Gen [Word8]
+arbitraryCompressionIDs = choose (0, 200) >>= vector
+
+someWords8 :: Int -> Gen [Word8]
+someWords8 = vector
+
+arbitraryHelloExtensions :: Version -> Gen [ExtensionRaw]
+arbitraryHelloExtensions _ver = arbitrary
+
+arbitraryCertReqContext :: Gen B.ByteString
+arbitraryCertReqContext = oneof [return B.empty, genByteString 32]
+
+----------------------------------------------------------------
+
+knownCiphers :: [Cipher]
+knownCiphers = ciphersuite_all
+
+instance Arbitrary Cipher where
+    arbitrary = elements knownCiphers
+
+knownVersions :: [Version]
+knownVersions = [TLS13, TLS12]
+
+arbitraryVersions :: Gen [Version]
+arbitraryVersions = sublistOf knownVersions
+
+-- for performance reason P521, FFDHE6144, FFDHE8192 are not tested
+knownGroups, knownECGroups, knownFFGroups :: [Group]
+knownECGroups = [P256, P384, X25519, X448]
+knownFFGroups = [FFDHE2048, FFDHE3072, FFDHE4096]
+knownGroups = knownECGroups ++ knownFFGroups
+
+defaultECGroup :: Group
+defaultECGroup = P256 -- same as defaultECCurve
+
+otherKnownECGroups :: [Group]
+otherKnownECGroups = filter (/= defaultECGroup) knownECGroups
+
+instance Arbitrary Group where
+    arbitrary = elements knownGroups
+
+instance {-# OVERLAPS #-} Arbitrary [Group] where
+    arbitrary = sublistOf knownGroups
+
+newtype EC = EC [Group] deriving (Show)
+
+instance Arbitrary EC where
+    arbitrary = EC <$> shuffle knownECGroups
+
+newtype FFDHE = FFDHE [Group] deriving (Show)
+
+instance Arbitrary FFDHE where
+    arbitrary = FFDHE <$> shuffle knownFFGroups
+
+isCredentialDSA :: (CertificateChain, PrivKey) -> Bool
+isCredentialDSA (_, PrivKeyDSA _) = True
+isCredentialDSA _ = False
+
+----------------------------------------------------------------
+
+arbitraryCredentialsOfEachType :: Gen [(CertificateChain, PrivKey)]
+arbitraryCredentialsOfEachType = arbitraryCredentialsOfEachType' >>= shuffle
+
+arbitraryCredentialsOfEachType' :: Gen [(CertificateChain, PrivKey)]
+arbitraryCredentialsOfEachType' = do
+    let (pubKey, privKey) = getGlobalRSAPair
+        curveName = defaultECCurve
+    (ecdsaPub, ecdsaPriv) <- arbitraryECDSAPair curveName
+    (ed25519Pub, ed25519Priv) <- arbitraryEd25519Pair
+    (ed448Pub, ed448Priv) <- arbitraryEd448Pair
+    mapM
+        ( \(pub, priv) -> do
+            cert <- arbitraryX509WithKey (pub, priv)
+            return (CertificateChain [cert], priv)
+        )
+        [ (PubKeyRSA pubKey, PrivKeyRSA privKey)
+        , (toPubKeyEC curveName ecdsaPub, toPrivKeyEC curveName ecdsaPriv)
+        , (PubKeyEd25519 ed25519Pub, PrivKeyEd25519 ed25519Priv)
+        , (PubKeyEd448 ed448Pub, PrivKeyEd448 ed448Priv)
+        ]
+
+arbitraryCredentialsOfEachCurve :: Gen [(CertificateChain, PrivKey)]
+arbitraryCredentialsOfEachCurve = arbitraryCredentialsOfEachCurve' >>= shuffle
+
+arbitraryCredentialsOfEachCurve' :: Gen [(CertificateChain, PrivKey)]
+arbitraryCredentialsOfEachCurve' = do
+    ecdsaPairs <-
+        mapM
+            ( \curveName -> do
+                (ecdsaPub, ecdsaPriv) <- arbitraryECDSAPair curveName
+                return (toPubKeyEC curveName ecdsaPub, toPrivKeyEC curveName ecdsaPriv)
+            )
+            knownECCurves
+    (ed25519Pub, ed25519Priv) <- arbitraryEd25519Pair
+    (ed448Pub, ed448Priv) <- arbitraryEd448Pair
+    mapM
+        ( \(pub, priv) -> do
+            cert <- arbitraryX509WithKey (pub, priv)
+            return (CertificateChain [cert], priv)
+        )
+        $ [ (PubKeyEd25519 ed25519Pub, PrivKeyEd25519 ed25519Priv)
+          , (PubKeyEd448 ed448Pub, PrivKeyEd448 ed448Priv)
+          ]
+            ++ ecdsaPairs
+
+----------------------------------------------------------------
+
+leafPublicKey :: CertificateChain -> Maybe PubKey
+leafPublicKey (CertificateChain []) = Nothing
+leafPublicKey (CertificateChain (leaf : _)) = Just (certPubKey $ getCertificate leaf)
+
+isLeafRSA :: Maybe CertificateChain -> Bool
+isLeafRSA chain = case chain >>= leafPublicKey of
+    Just (PubKeyRSA _) -> True
+    _ -> False
+
+arbitraryCipherPair :: Version -> Gen ([Cipher], [Cipher])
+arbitraryCipherPair connectVersion = do
+    serverCiphers <-
+        arbitrary
+            `suchThat` (\cs -> or [cipherAllowedForVersion connectVersion x | x <- cs])
+    clientCiphers <-
+        arbitrary
+            `suchThat` ( \cs ->
+                            or
+                                [ x `elem` serverCiphers
+                                    && cipherAllowedForVersion connectVersion x
+                                | x <- cs
+                                ]
+                       )
+    return (clientCiphers, serverCiphers)
+
+----------------------------------------------------------------
+
+instance {-# OVERLAPS #-} Arbitrary (ClientParams, ServerParams) where
+    arbitrary = elements knownVersions >>= arbitraryPairParamsAt
+
+----------------------------------------------------------------
+
+data GGP = GGP [Group] [Group] deriving (Show)
+
+instance Arbitrary GGP where
+    arbitrary = arbitraryGroupPair
+
+-- Pair of groups so that at least the default EC group P256 and one FF group
+-- are in common.  This makes DHE and ECDHE ciphers always compatible with
+-- extension "Supported Elliptic Curves" / "Supported Groups".
+arbitraryGroupPair :: Gen GGP
+arbitraryGroupPair = do
+    (serverECGroups, clientECGroups) <-
+        arbitraryGroupPairWith defaultECGroup otherKnownECGroups
+    serverGroups <- shuffle serverECGroups
+    clientGroups <- shuffle clientECGroups
+    return $ GGP clientGroups serverGroups
+  where
+    arbitraryGroupPairWith e es = do
+        s <- sublistOf es
+        c <- sublistOf es
+        return (e : s, e : c)
+
+----------------------------------------------------------------
+
+arbitraryPairParams12 :: Gen (ClientParams, ServerParams)
+arbitraryPairParams12 = arbitraryPairParamsAt TLS12
+
+arbitraryPairParams13 :: Gen (ClientParams, ServerParams)
+arbitraryPairParams13 = arbitraryPairParamsAt TLS13
+
+arbitraryPairParamsAt :: Version -> Gen (ClientParams, ServerParams)
+arbitraryPairParamsAt connectVersion = do
+    (clientCiphers, serverCiphers) <- arbitraryCipherPair connectVersion
+    -- Select version lists containing connectVersion, as well as some other
+    -- versions for which we have compatible ciphers.  Criteria about cipher
+    -- ensure we can test version downgrade.
+    let allowedVersions =
+            [ v
+            | v <- knownVersions
+            , or
+                [ x `elem` serverCiphers
+                    && cipherAllowedForVersion v x
+                | x <- clientCiphers
+                ]
+            ]
+        allowedVersionsFiltered = filter (<= connectVersion) allowedVersions
+    -- Server or client is allowed to have versions > connectVersion, but not
+    -- both simultaneously.
+    filterSrv <- arbitrary
+    let (clientAllowedVersions, serverAllowedVersions)
+            | filterSrv = (allowedVersions, allowedVersionsFiltered)
+            | otherwise = (allowedVersionsFiltered, allowedVersions)
+    -- Generate version lists containing less than 127 elements, otherwise the
+    -- "supported_versions" extension cannot be correctly serialized
+    clientVersions <- listWithOthers connectVersion 126 clientAllowedVersions
+    serverVersions <- listWithOthers connectVersion 126 serverAllowedVersions
+    arbitraryPairParamsWithVersionsAndCiphers
+        (clientVersions, serverVersions)
+        (clientCiphers, serverCiphers)
+  where
+    listWithOthers :: a -> Int -> [a] -> Gen [a]
+    listWithOthers fixedElement maxOthers others
+        | maxOthers < 1 = return [fixedElement]
+        | otherwise = sized $ \n -> do
+            num <- choose (0, min n maxOthers)
+            pos <- choose (0, num)
+            prefix <- vectorOf pos $ elements others
+            suffix <- vectorOf (num - pos) $ elements others
+            return $ prefix ++ (fixedElement : suffix)
+
+----------------------------------------------------------------
+
+getConnectVersion :: (ClientParams, ServerParams) -> Version
+getConnectVersion (cparams, sparams) = maximum (cver `intersect` sver)
+  where
+    sver = supportedVersions (serverSupported sparams)
+    cver = supportedVersions (clientSupported cparams)
+
+isVersionEnabled :: Version -> (ClientParams, ServerParams) -> Bool
+isVersionEnabled ver (cparams, sparams) =
+    (ver `elem` supportedVersions (serverSupported sparams))
+        && (ver `elem` supportedVersions (clientSupported cparams))
+
+arbitraryPairParamsWithVersionsAndCiphers
+    :: ([Version], [Version])
+    -> ([Cipher], [Cipher])
+    -> Gen (ClientParams, ServerParams)
+arbitraryPairParamsWithVersionsAndCiphers (clientVersions, serverVersions) (clientCiphers, serverCiphers) = do
+    secNeg <- arbitrary
+
+    creds <- arbitraryCredentialsOfEachType
+    GGP clientGroups serverGroups <- arbitraryGroupPair
+    clientHashSignatures <- arbitrary
+    serverHashSignatures <- arbitrary
+    let serverState =
+            defaultParamsServer
+                { serverSupported =
+                    defaultSupported
+                        { supportedCiphers = serverCiphers
+                        , supportedVersions = serverVersions
+                        , supportedSecureRenegotiation = secNeg
+                        , supportedHashSignatures = serverHashSignatures
+                        , supportedGroups = serverGroups
+                        , supportedGroupsTLS13 = [serverGroups]
+                        }
+                , serverShared = defaultShared{sharedCredentials = Credentials creds}
+                }
+    let clientState =
+            (defaultParamsClient "" B.empty)
+                { clientSupported =
+                    defaultSupported
+                        { supportedCiphers = clientCiphers
+                        , supportedVersions = clientVersions
+                        , supportedSecureRenegotiation = secNeg
+                        , supportedGroups = clientGroups
+                        , supportedHashSignatures = clientHashSignatures
+                        }
+                , clientShared =
+                    defaultShared
+                        { sharedValidationCache =
+                            ValidationCache
+                                { cacheAdd = \_ _ _ -> return ()
+                                , cacheQuery = \_ _ _ -> return ValidationCachePass
+                                }
+                        }
+                }
+    return (clientState, serverState)
+
+arbitraryClientCredential :: Version -> Gen Credential
+arbitraryClientCredential _ = arbitraryCredentialsOfEachCurve' >>= elements
+
+arbitraryRSACredentialWithUsage
+    :: [ExtKeyUsageFlag] -> Gen (CertificateChain, PrivKey)
+arbitraryRSACredentialWithUsage usageFlags = do
+    let (pubKey, privKey) = getGlobalRSAPair
+    cert <- arbitraryX509WithKeyAndUsage usageFlags (PubKeyRSA pubKey, ())
+    return (CertificateChain [cert], PrivKeyRSA privKey)
+
+instance {-# OVERLAPS #-} Arbitrary (EMSMode, EMSMode) where
+    arbitrary = (,) <$> gen <*> gen
+      where
+        gen = elements [NoEMS, AllowEMS, RequireEMS]
+
+setEMSMode
+    :: (EMSMode, EMSMode)
+    -> (ClientParams, ServerParams)
+    -> (ClientParams, ServerParams)
+setEMSMode (cems, sems) (clientParam, serverParam) = (clientParam', serverParam')
+  where
+    clientParam' =
+        clientParam
+            { clientSupported =
+                (clientSupported clientParam)
+                    { supportedExtendedMainSecret = cems
+                    }
+            }
+    serverParam' =
+        serverParam
+            { serverSupported =
+                (serverSupported serverParam)
+                    { supportedExtendedMainSecret = sems
+                    }
+            }
+
+genByteString :: Int -> Gen B.ByteString
+genByteString i = B.pack <$> vector i
+
+-- Just for preventing warnings of GHC 9.10
+unsafeHead :: [a] -> a
+unsafeHead [] = error "unsafeHead"
+unsafeHead (x : _) = x
diff --git a/test/Certificate.hs b/test/Certificate.hs
new file mode 100644
--- /dev/null
+++ b/test/Certificate.hs
@@ -0,0 +1,161 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Certificate (
+    arbitraryX509,
+    arbitraryX509WithKey,
+    arbitraryX509WithKeyAndUsage,
+    arbitraryDN,
+    simpleCertificate,
+    simpleX509,
+    getSignatureALG,
+    toPubKeyEC,
+    toPrivKeyEC,
+) where
+
+import Crypto.Number.Serialize (i2ospOf_)
+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Crypto.PubKey.ECC.Types as ECC
+import Data.ASN1.OID
+import qualified Data.ByteString as B
+import Data.Hourglass
+import Data.X509
+import Test.QuickCheck
+
+import PubKey
+
+arbitraryDN :: Gen DistinguishedName
+arbitraryDN = return $ DistinguishedName []
+
+instance Arbitrary Date where
+    arbitrary = do
+        y <- choose (1971, 2035)
+        m <- elements [January .. December]
+        d <- choose (1, 30)
+        return $ normalizeDate $ Date y m d
+
+normalizeDate :: Date -> Date
+normalizeDate d = timeConvert (timeConvert d :: Elapsed)
+
+instance Arbitrary TimeOfDay where
+    arbitrary = do
+        h <- choose (0, 23)
+        mi <- choose (0, 59)
+        se <- choose (0, 59)
+        let nsec = 0
+        return $ TimeOfDay (Hours h) (Minutes mi) (Seconds se) nsec
+
+instance Arbitrary DateTime where
+    arbitrary = DateTime <$> arbitrary <*> arbitrary
+
+maxSerial :: Integer
+maxSerial = 16777216
+
+arbitraryCertificate :: [ExtKeyUsageFlag] -> PubKey -> Gen Certificate
+arbitraryCertificate usageFlags pubKey = do
+    serial <- choose (0, maxSerial)
+    subjectdn <- arbitraryDN
+    validity <- (,) <$> arbitrary <*> arbitrary
+    let sigalg = getSignatureALG pubKey
+    return $
+        Certificate
+            { certVersion = 3
+            , certSerial = serial
+            , certSignatureAlg = sigalg
+            , certIssuerDN = issuerdn
+            , certSubjectDN = subjectdn
+            , certValidity = validity
+            , certPubKey = pubKey
+            , certExtensions =
+                Extensions $
+                    Just
+                        [ extensionEncode True $ ExtKeyUsage usageFlags
+                        ]
+            }
+  where
+    issuerdn = DistinguishedName [(getObjectID DnCommonName, "Root CA")]
+
+simpleCertificate :: PubKey -> Certificate
+simpleCertificate pubKey =
+    Certificate
+        { certVersion = 3
+        , certSerial = 0
+        , certSignatureAlg = getSignatureALG pubKey
+        , certIssuerDN = simpleDN
+        , certSubjectDN = simpleDN
+        , certValidity = (time1, time2)
+        , certPubKey = pubKey
+        , certExtensions =
+            Extensions $
+                Just
+                    [ extensionEncode True $
+                        ExtKeyUsage [KeyUsage_digitalSignature, KeyUsage_keyEncipherment]
+                    ]
+        }
+  where
+    time1 = DateTime (Date 1999 January 1) (TimeOfDay 0 0 0 0)
+    time2 = DateTime (Date 2049 January 1) (TimeOfDay 0 0 0 0)
+    simpleDN = DistinguishedName []
+
+simpleX509 :: PubKey -> SignedCertificate
+simpleX509 pubKey =
+    let cert = simpleCertificate pubKey
+        sig = replicate 40 1
+        sigalg = getSignatureALG pubKey
+        (signedExact, ()) = objectToSignedExact (\_ -> (B.pack sig, sigalg, ())) cert
+     in signedExact
+
+arbitraryX509WithKey :: (PubKey, t) -> Gen SignedCertificate
+arbitraryX509WithKey = arbitraryX509WithKeyAndUsage knownKeyUsage
+
+arbitraryX509WithKeyAndUsage
+    :: [ExtKeyUsageFlag] -> (PubKey, t) -> Gen SignedCertificate
+arbitraryX509WithKeyAndUsage usageFlags (pubKey, _) = do
+    cert <- arbitraryCertificate usageFlags pubKey
+    sig <- resize 40 $ listOf1 arbitrary
+    let sigalg = getSignatureALG pubKey
+    let (signedExact, ()) = objectToSignedExact (\_ -> (B.pack sig, sigalg, ())) cert
+    return signedExact
+
+arbitraryX509 :: Gen SignedCertificate
+arbitraryX509 = do
+    let (pubKey, privKey) = getGlobalRSAPair
+    arbitraryX509WithKey (PubKeyRSA pubKey, PrivKeyRSA privKey)
+
+instance {-# OVERLAPS #-} Arbitrary [ExtKeyUsageFlag] where
+    arbitrary = sublistOf knownKeyUsage
+
+knownKeyUsage :: [ExtKeyUsageFlag]
+knownKeyUsage =
+    [ KeyUsage_digitalSignature
+    , KeyUsage_keyEncipherment
+    , KeyUsage_keyAgreement
+    ]
+
+getSignatureALG :: PubKey -> SignatureALG
+getSignatureALG (PubKeyRSA _) = SignatureALG HashSHA1 PubKeyALG_RSA
+getSignatureALG (PubKeyDSA _) = SignatureALG HashSHA1 PubKeyALG_DSA
+getSignatureALG (PubKeyEC _) = SignatureALG HashSHA256 PubKeyALG_EC
+getSignatureALG (PubKeyEd25519 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed25519
+getSignatureALG (PubKeyEd448 _) = SignatureALG_IntrinsicHash PubKeyALG_Ed448
+getSignatureALG pubKey =
+    error $ "getSignatureALG: unsupported public key: " ++ show pubKey
+
+toPubKeyEC :: ECC.CurveName -> ECDSA.PublicKey -> PubKey
+toPubKeyEC curveName key =
+    let (x, y) = fromPoint $ ECDSA.public_q key
+        pub = SerializedPoint bs
+        bs = B.cons 4 (i2ospOf_ bytes x `B.append` i2ospOf_ bytes y)
+        bits = ECC.curveSizeBits (ECC.getCurveByName curveName)
+        bytes = (bits + 7) `div` 8
+     in PubKeyEC (PubKeyEC_Named curveName pub)
+
+toPrivKeyEC :: ECC.CurveName -> ECDSA.PrivateKey -> PrivKey
+toPrivKeyEC curveName key =
+    let priv = ECDSA.private_d key
+     in PrivKeyEC (PrivKeyEC_Named curveName priv)
+
+fromPoint :: ECC.Point -> (Integer, Integer)
+fromPoint (ECC.Point x y) = (x, y)
+fromPoint _ = error "fromPoint"
diff --git a/test/CiphersSpec.hs b/test/CiphersSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/CiphersSpec.hs
@@ -0,0 +1,76 @@
+module CiphersSpec where
+
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Network.TLS.Cipher
+import Network.TLS.Extra.Cipher
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+
+spec :: Spec
+spec = do
+    describe "ciphers" $ do
+        prop "can ecnrypt/decrypt" $ \(BulkTest bulk key iv t additional) -> do
+            let enc = bulkInit bulk BulkEncrypt key
+                dec = bulkInit bulk BulkDecrypt key
+            case (enc, dec) of
+                (BulkStateBlock encF, BulkStateBlock decF) -> block encF decF iv t
+                (BulkStateAEAD encF, BulkStateAEAD decF) -> aead encF decF iv t additional
+                (BulkStateStream (BulkStream encF), BulkStateStream (BulkStream decF)) -> stream encF decF t
+                _ -> return ()
+
+block
+    :: BulkBlock
+    -> BulkBlock
+    -> BulkIV
+    -> ByteString
+    -> IO ()
+block e d iv t = do
+    let (etxt, e_iv) = e iv t
+        (dtxt, d_iv) = d iv etxt
+    dtxt `shouldBe` t
+    d_iv `shouldBe` e_iv
+
+stream
+    :: (ByteString -> (ByteString, BulkStream))
+    -> (ByteString -> (ByteString, BulkStream))
+    -> ByteString
+    -> Expectation
+stream e d t = (fst . d . fst . e) t `shouldBe` t
+
+aead
+    :: BulkAEAD
+    -> BulkAEAD
+    -> BulkNonce
+    -> ByteString
+    -> BulkAdditionalData
+    -> Expectation
+aead e d iv t additional = do
+    let (encrypted, at) = e iv t additional
+        (decrypted, at2) = d iv encrypted additional
+    decrypted `shouldBe` t
+    at `shouldBe` at2
+
+arbitraryKey :: Bulk -> Gen BA.ScrubbedBytes
+arbitraryKey bulk = BA.pack `fmap` vector (bulkKeySize bulk)
+
+arbitraryIV :: Bulk -> Gen B.ByteString
+arbitraryIV bulk = B.pack `fmap` vector (bulkIVSize bulk + bulkExplicitIV bulk)
+
+arbitraryText :: Bulk -> Gen B.ByteString
+arbitraryText bulk = B.pack `fmap` vector (bulkBlockSize bulk)
+
+data BulkTest
+    = BulkTest Bulk BA.ScrubbedBytes B.ByteString B.ByteString B.ByteString
+    deriving (Show, Eq)
+
+instance Arbitrary BulkTest where
+    arbitrary = do
+        bulk <- cipherBulk `fmap` elements ciphersuite_all
+        BulkTest bulk
+            <$> arbitraryKey bulk
+            <*> arbitraryIV bulk
+            <*> arbitraryText bulk
+            <*> arbitraryText bulk
diff --git a/test/ECHSpec.hs b/test/ECHSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ECHSpec.hs
@@ -0,0 +1,446 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module ECHSpec (spec) where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Lazy as L
+import Data.Maybe
+import Network.TLS
+import Network.TLS.ECH.Config
+import Network.TLS.Extra.Cipher
+import Network.TLS.Internal
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+
+import Arbitrary
+import Run
+import Session
+
+spec :: Spec
+spec = do
+    describe "ECH" $ do
+        prop "can handshake with TLS 1.3 Full" handshake13_full
+        prop "can handshake with TLS 1.3 HRR" handshake13_hrr
+        prop "can handshake with TLS 1.3 PSK" handshake13_psk
+        prop "can handshake with TLS 1.3 PSK ticket" handshake13_psk_ticket
+        prop "can handshake with TLS 1.3 PSK -> HRR" handshake13_psk_fallback
+        prop "can handshake with TLS 1.3 0RTT" handshake13_0rtt
+        prop "can handshake with TLS 1.3 0RTT -> PSK" handshake13_0rtt_fallback
+        prop "can handshake with TLS 1.3 EC groups" handshake13_ec
+        prop "can handshake with TLS 1.3 FFDHE groups" handshake13_ffdhe
+    describe "ECH greasing" $ do
+        prop "sends greasing ECH" handshake13_greasing
+        prop "sends greasing ECH HRR" handshake13_greasing_hrr
+
+--------------------------------------------------------------
+
+newtype CSP13 = CSP13 (ClientParams, ServerParams) deriving (Show)
+
+instance Arbitrary CSP13 where
+    arbitrary = CSP13 <$> arbitraryPairParams13
+
+--------------------------------------------------------------
+
+handshake13_full :: CSP13 -> IO ()
+handshake13_full (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv{serverSupported = svrSupported}
+                )
+    runTLSSimple13ECH params FullHandshake
+
+handshake13_hrr :: CSP13 -> IO ()
+handshake13_hrr (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv{serverSupported = svrSupported}
+                )
+    runTLSSimple13ECH params HelloRetryRequest
+
+handshake13_psk :: CSP13 -> IO ()
+handshake13_psk (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params0 =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv{serverSupported = svrSupported}
+                )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13ECH params HelloRetryRequest
+
+    -- and resume
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let params2 = setPairParamsSessionResuming (fromJust sessionParams) params
+
+    runTLSSimple13ECH params2 PreSharedKey
+
+handshake13_psk_ticket :: CSP13 -> IO ()
+handshake13_psk_ticket (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params0 =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv{serverSupported = svrSupported}
+                )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers0 = twoSessionManagers sessionRefs
+        sessionManagers = (fst sessionManagers0, oneSessionTicket)
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13ECH params HelloRetryRequest
+
+    -- and resume
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let params2 = setPairParamsSessionResuming (fromJust sessionParams) params
+
+    runTLSSimple13ECH params2 PreSharedKey
+
+handshake13_psk_fallback :: CSP13 -> IO ()
+handshake13_psk_fallback (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers =
+                    [ cipher13_AES_128_GCM_SHA256
+                    , cipher13_AES_128_CCM_SHA256
+                    ]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params0 =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv{serverSupported = svrSupported}
+                )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13ECH params HelloRetryRequest
+
+    -- resumption fails because GCM cipher is not supported anymore, full
+    -- handshake is not possible because X25519 has been removed, so we are
+    -- back with P256 after hello retry
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let (cli2, srv2) = setPairParamsSessionResuming (fromJust sessionParams) params
+        srv2' = srv2{serverSupported = svrSupported'}
+        svrSupported' =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_CCM_SHA256]
+                , supportedGroups = [P256]
+                , supportedGroupsTLS13 = [[P256]]
+                }
+
+    runTLSSimple13ECH (cli2, srv2') HelloRetryRequest
+
+handshake13_0rtt :: CSP13 -> IO ()
+handshake13_0rtt (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        cliHooks =
+            defaultClientHooks
+                { onSuggestALPN = return $ Just ["h2"]
+                }
+        svrHooks =
+            defaultServerHooks
+                { onALPNClientSuggest = Just (return . unsafeHead)
+                }
+        params0 =
+            setParams
+                ( cli
+                    { clientSupported = cliSupported
+                    , clientHooks = cliHooks
+                    }
+                , srv
+                    { serverSupported = svrSupported
+                    , serverHooks = svrHooks
+                    , serverEarlyDataSize = 2048
+                    }
+                )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13ECH params HelloRetryRequest
+    runTLS0rtt params sessionRefs
+    runTLS0rtt params sessionRefs
+  where
+    runTLS0rtt params sessionRefs = do
+        -- and resume
+        sessionParams <- readClientSessionRef sessionRefs
+        expectJust "session param should be Just" sessionParams
+        clearClientSessionRef sessionRefs
+        earlyData <- B.pack <$> generate (someWords8 256)
+        let (pc, ps) = setPairParamsSessionResuming (fromJust sessionParams) params
+            params2 = (pc{clientUseEarlyData = True}, ps)
+
+        runTLS0RTTech params2 RTT0 earlyData
+
+handshake13_0rtt_fallback :: CSP13 -> IO ()
+handshake13_0rtt_fallback (CSP13 (cli, srv)) = do
+    group0 <- generate $ elements [P256, X25519]
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [group0]
+                , supportedGroupsTLS13 = [[group0]]
+                }
+        params =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv
+                    { serverSupported = svrSupported
+                    , serverEarlyDataSize = 1024
+                    }
+                )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params0 = setPairParamsSessionManagers sessionManagers params
+
+    let mode = if group0 == P256 then FullHandshake else HelloRetryRequest
+    runTLSSimple13ECH params0 mode
+
+    -- and resume
+    mSessionParams <- readClientSessionRef sessionRefs
+    case mSessionParams of
+        Nothing -> expectationFailure "session params: Just is expected"
+        Just sessionParams -> do
+            earlyData <- B.pack <$> generate (someWords8 256)
+            group1 <- generate $ elements [P256, X25519]
+            let (pc, ps) = setPairParamsSessionResuming sessionParams params0
+                svrSupported1 =
+                    defaultSupported
+                        { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                        , supportedGroups = [group1]
+                        , supportedGroupsTLS13 = [[group1]]
+                        }
+                params1 =
+                    ( pc{clientUseEarlyData = True}
+                    , ps
+                        { serverEarlyDataSize = 0
+                        , serverSupported = svrSupported1
+                        }
+                    )
+            -- C: [P256, X25519]
+            -- S: [group0]
+            -- C: [P256, X25519]
+            -- S: [group1]
+            if group0 == group1
+                -- 0-RTT is not allowed, so fallback to PreSharedKey
+                then runTLS0RTTech params1 PreSharedKey earlyData
+                -- HRR but not allowed for 0-RTT
+                else runTLSFailure params1 (tlsClient earlyData) tlsServer
+  where
+    tlsClient earlyData ctx = do
+        handshake ctx
+        sendData ctx $ L.fromStrict earlyData
+        _ <- recvData ctx
+        bye ctx
+    tlsServer ctx = do
+        handshake ctx
+        _ <- recvData ctx
+        bye ctx
+
+handshake13_ec :: CSP13 -> IO ()
+handshake13_ec (CSP13 (cli, srv)) = do
+    EC cgrps <- generate arbitrary
+    EC sgrps <- generate arbitrary
+    let cliSupported = (clientSupported cli){supportedGroups = cgrps}
+        svrSupported =
+            (serverSupported srv)
+                { supportedGroups = sgrps
+                , supportedGroupsTLS13 = [sgrps]
+                }
+        params =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv{serverSupported = svrSupported}
+                )
+    runTLSSimple13ECH params FullHandshake
+
+handshake13_ffdhe :: CSP13 -> IO ()
+handshake13_ffdhe (CSP13 (cli, srv)) = do
+    FFDHE cgrps <- generate arbitrary
+    FFDHE sgrps <- generate arbitrary
+    let cliSupported = (clientSupported cli){supportedGroups = cgrps}
+        svrSupported =
+            (serverSupported srv)
+                { supportedGroups = sgrps
+                , supportedGroupsTLS13 = [sgrps]
+                }
+
+        params =
+            setParams
+                ( cli{clientSupported = cliSupported}
+                , srv{serverSupported = svrSupported}
+                )
+    runTLSSimple13ECH params FullHandshake
+
+handshake13_greasing :: CSP13 -> IO ()
+handshake13_greasing (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params =
+            ( cli
+                { clientSupported = cliSupported
+                , clientUseECH = True
+                , clientShared = (clientShared cli){sharedECHConfigList = echConfList}
+                }
+            , srv{serverSupported = svrSupported}
+            )
+    (clientMessages, _) <- runTLSCaptureFail params
+    let isGreasing (ExtensionRaw eid _) = eid == EID_EncryptedClientHello
+        eeMessagesHaveExt =
+            [ any isGreasing chExtensions
+            | ClientHello CH{..} <- clientMessages
+            ]
+    eeMessagesHaveExt `shouldBe` [True]
+
+handshake13_greasing_hrr :: CSP13 -> IO ()
+handshake13_greasing_hrr (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params =
+            ( cli
+                { clientSupported = cliSupported
+                , clientUseECH = True
+                , clientShared = (clientShared cli){sharedECHConfigList = echConfList}
+                }
+            , srv{serverSupported = svrSupported}
+            )
+    (clientMessages, _) <- runTLSCaptureFail params
+    let isGreasing (ExtensionRaw eid _) = eid == EID_EncryptedClientHello
+        eeMessagesHaveExt =
+            [ any isGreasing chExtensions
+            | ClientHello CH{..} <- clientMessages
+            ]
+    eeMessagesHaveExt `shouldBe` [True, True]
+
+expectJust :: String -> Maybe a -> Expectation
+expectJust tag mx = case mx of
+    Nothing -> expectationFailure tag
+    Just _ -> return ()
+
+setParams :: (ClientParams, ServerParams) -> (ClientParams, ServerParams)
+setParams (cli, srv) = (cli', srv')
+  where
+    cli' =
+        cli
+            { clientUseECH = True
+            , clientShared = (clientShared cli){sharedECHConfigList = echConfList}
+            }
+    srv' =
+        srv
+            { serverECHKey = echKey
+            , serverShared = (serverShared srv){sharedECHConfigList = echConfList}
+            }
+
+echKey :: [(ConfigId, ByteString)]
+echKey = [(0, B64.decodeLenient "GAl/YqzDDnssODe5t+2xlQsbSv26kNlfJ0D+nZbK62I=")]
+
+echConfList :: ECHConfigList
+echConfList =
+    fromJust $
+        decodeECHConfigList $
+            B64.decodeLenient
+                "AEP+DQA/AAAgACDGNVZWrmqQfzAuYGJNa8+OEc6zaUfzd0ltyJQ2y1U2AwAEAAEAAQAQcHVibGljLWxvY2FsaG9zdAAA"
diff --git a/test/EncodeSpec.hs b/test/EncodeSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/EncodeSpec.hs
@@ -0,0 +1,39 @@
+module EncodeSpec where
+
+import Data.ByteString (ByteString)
+import Network.TLS
+import Network.TLS.Internal
+import Test.Hspec
+import Test.Hspec.QuickCheck
+
+import Arbitrary ()
+
+spec :: Spec
+spec = do
+    describe "encoder/decoder" $ do
+        prop "can encode/decode Header" $ \x -> do
+            decodeHeader (encodeHeader x) `shouldBe` Right x
+        prop "can encode/decode Handshake" $ \x -> do
+            decodeHs (encodeHandshake x) `shouldBe` Right x
+        prop "can encode/decode Handshake13" $ \x -> do
+            decodeHs13 (encodeHandshake13 x) `shouldBe` Right x
+
+decodeHs :: ByteString -> Either TLSError Handshake
+decodeHs b = verifyResult (decodeHandshake cp) $ decodeHandshakeRecord b
+  where
+    cp =
+        CurrentParams
+            { cParamsVersion = TLS12
+            , cParamsKeyXchgType = Just CipherKeyExchange_RSA
+            }
+
+decodeHs13 :: ByteString -> Either TLSError Handshake13
+decodeHs13 b = verifyResult decodeHandshake13 $ decodeHandshakeRecord13 b
+
+verifyResult :: (f -> r -> a) -> GetResult (f, r) -> a
+verifyResult fn result =
+    case result of
+        GotPartial _ -> error "got partial"
+        GotError e -> error ("got error: " ++ show e)
+        GotSuccessRemaining _ _ -> error "got remaining byte left"
+        GotSuccess (ty, content) -> fn ty content
diff --git a/test/HandshakeSpec.hs b/test/HandshakeSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/HandshakeSpec.hs
@@ -0,0 +1,1088 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module HandshakeSpec where
+
+import Control.Monad
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import Data.IORef
+import Data.List
+import Data.Maybe
+import Data.X509 (ExtKeyUsageFlag (..))
+import Network.TLS
+import Network.TLS.Extra.Cipher
+import Network.TLS.Extra.CipherCBC
+import Network.TLS.Internal
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+
+import API
+import Arbitrary
+import PipeChan
+import Run
+import Session
+
+spec :: Spec
+spec = do
+    describe "pipe" $ do
+        it "can setup a channel" pipe_work
+    describe "handshake" $ do
+        prop "can run TLS 1.2" handshake_simple
+        prop "can run TLS 1.3" handshake13_simple
+        prop "can update key for TLS 1.3" handshake_update_key
+        prop "can prevent downgrade attack" handshake13_downgrade
+        prop "can negotiate hash and signature" handshake_hashsignatures
+        prop "can negotiate cipher suite" handshake_ciphersuites
+        prop "can negotiate group" handshake_groups
+        prop "can negotiate elliptic curve" handshake_ec
+        prop "can fallback for certificate with cipher" handshake_cert_fallback_cipher
+        prop
+            "can fallback for certificate with hash and signature"
+            handshake_cert_fallback_hs
+        prop "can handle server key usage" handshake_server_key_usage
+        prop "can handle client key usage" handshake_client_key_usage
+        prop "can authenticate client" handshake_client_auth
+        prop "can receive client authentication failure" handshake_client_auth_fail
+        prop "can handle extended main secret" handshake_ems
+        prop "can resume with extended main secret" handshake_resumption_ems
+        prop "can handle ALPN" handshake_alpn
+        prop "can handle SNI" handshake_sni
+        prop "can handshake with TLS 1.2 CBC" handshake_cbc
+        prop "can re-negotiate with TLS 1.2" handshake12_renegotiation
+        prop "can resume session with TLS 1.2" handshake12_session_resumption
+        prop "can resume session ticket with TLS 1.2" handshake12_session_ticket
+        prop "can handshake with TLS 1.3 Full" handshake13_full
+        prop "can handshake with TLS 1.3 HRR" handshake13_hrr
+        prop "can handshake with TLS 1.3 PSK" handshake13_psk
+        prop "can handshake with TLS 1.3 PSK ticket" handshake13_psk_ticket
+        prop "can handshake with TLS 1.3 PSK -> HRR" handshake13_psk_fallback
+        prop "can handshake with TLS 1.3 0RTT" handshake13_0rtt
+        prop "can handshake with TLS 1.3 0RTT -> PSK" handshake13_0rtt_fallback
+        prop "can handshake with TLS 1.3 EE" handshake13_ee_groups
+        prop "can handshake with TLS 1.3 EC groups" handshake13_ec
+        prop "can handshake with TLS 1.3 FFDHE groups" handshake13_ffdhe
+        prop "can handshake with TLS 1.3 Post-handshake auth" post_handshake_auth
+
+--------------------------------------------------------------
+
+pipe_work :: IO ()
+pipe_work = do
+    pipe <- newPipe
+    _ <- runPipe pipe
+
+    let bSize = 16
+    n <- generate (choose (1, 32))
+
+    let d1 = B.replicate (bSize * n) 40
+    let d2 = B.replicate (bSize * n) 45
+
+    d1' <- writePipeC pipe d1 >> readPipeS pipe (B.length d1)
+    d1' `shouldBe` d1
+
+    d2' <- writePipeS pipe d2 >> readPipeC pipe (B.length d2)
+    d2' `shouldBe` d2
+
+--------------------------------------------------------------
+
+handshake_simple :: (ClientParams, ServerParams) -> IO ()
+handshake_simple = runTLSSimple
+
+--------------------------------------------------------------
+
+newtype CSP13 = CSP13 (ClientParams, ServerParams) deriving (Show)
+
+instance Arbitrary CSP13 where
+    arbitrary = CSP13 <$> arbitraryPairParams13
+
+handshake13_simple :: CSP13 -> IO ()
+handshake13_simple (CSP13 params) = runTLSSimple13 params hs
+  where
+    cgrps = supportedGroups $ clientSupported $ fst params
+    sgrps = supportedGroups $ serverSupported $ snd params
+    hs = if unsafeHead cgrps `elem` sgrps then FullHandshake else HelloRetryRequest
+
+--------------------------------------------------------------
+
+handshake_cbc :: IO ()
+handshake_cbc = do
+    clientCiphers <- generate $ cipherGen >>= shuffle
+    serverCiphers <- generate $ cipherGen >>= shuffle
+    clientGroups <- generate $ groupGen >>= shuffle
+    serverGroups <- generate $ groupGen >>= shuffle
+    (clientParam, serverParam) <- generate $
+        arbitraryPairParamsWithVersionsAndCiphers
+            ([TLS12], [TLS12])
+            (clientCiphers, serverCiphers)
+    let clientParam' = clientParam {
+            clientSupported = (clientSupported clientParam)
+                { supportedGroups = clientGroups } }
+        serverParam' = serverParam {
+            serverSupported = (serverSupported serverParam)
+                { supportedGroups = serverGroups } }
+    let ciphers = clientCiphers `intersect` serverCiphers
+        groups = clientGroups `intersect` serverGroups
+     in if compat ciphers groups
+        then runTLSSimple (clientParam', serverParam')
+        else runTLSFailure (clientParam', serverParam') handshake handshake
+  where
+    groupGen :: Gen [Group]
+    groupGen = sublistOf grps `suchThat` (not . null)
+      where
+        grps = [X25519, P256, P384, FFDHE2048, FFDHE3072, FFDHE4096]
+
+    cipherGen :: Gen [Cipher]
+    cipherGen = sublistOf ciphersuite_pfs_sha2_cbc `suchThat` (not . null)
+
+    compat :: [Cipher] -> [Group] -> Bool
+    compat [] _ = False
+    compat _ [] = False
+    compat ciphers groups =
+        let mustdh = all (== CipherKeyExchange_DHE_RSA) $ map cipherKeyExchange ciphers
+            mustec = all (/= CipherKeyExchange_DHE_RSA) $ map cipherKeyExchange ciphers
+            havedh = any (`elem` [FFDHE2048, FFDHE3072, FFDHE4096]) groups
+            haveec = any (`elem` [X25519, P256, P384]) groups
+         in ((not mustdh || havedh) && (not mustec || haveec))
+
+--------------------------------------------------------------
+
+handshake13_downgrade :: (ClientParams, ServerParams) -> IO ()
+handshake13_downgrade (cparam, sparam) = do
+    versionForced <-
+        generate $ elements (supportedVersions $ clientSupported cparam)
+    let debug' = (serverDebug sparam){debugVersionForced = Just versionForced}
+        sparam' = sparam{serverDebug = debug'}
+        params = (cparam, sparam')
+        downgraded =
+            (isVersionEnabled TLS13 params && versionForced < TLS13)
+                || (isVersionEnabled TLS12 params && versionForced < TLS12)
+    if downgraded
+        then runTLSFailure params handshake handshake
+        else runTLSSimple params
+
+handshake_update_key :: (ClientParams, ServerParams) -> IO ()
+handshake_update_key = runTLSSimpleKeyUpdate
+
+--------------------------------------------------------------
+
+handshake_hashsignatures
+    :: ([HashAndSignatureAlgorithm], [HashAndSignatureAlgorithm]) -> IO ()
+handshake_hashsignatures (clientHashSigs, serverHashSigs) = do
+    tls13 <- generate arbitrary
+    let version = if tls13 then TLS13 else TLS12
+        ciphers =
+            [ cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384
+            , cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384
+            , cipher13_AES_128_GCM_SHA256
+            ]
+    (clientParam, serverParam) <-
+        generate $
+            arbitraryPairParamsWithVersionsAndCiphers
+                ([version], [version])
+                (ciphers, ciphers)
+    let clientParam' =
+            clientParam
+                { clientSupported =
+                    (clientSupported clientParam)
+                        { supportedHashSignatures = clientHashSigs
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverSupported =
+                    (serverSupported serverParam)
+                        { supportedHashSignatures = serverHashSigs
+                        }
+                }
+        commonHashSigs = clientHashSigs `intersect` serverHashSigs
+        shouldFail
+            | tls13 = all incompatibleWithDefaultCurve commonHashSigs
+            | otherwise = null commonHashSigs
+    if shouldFail
+        then runTLSFailure (clientParam', serverParam') handshake handshake
+        else runTLSSimple (clientParam', serverParam')
+  where
+    incompatibleWithDefaultCurve (h, SignatureECDSA) = h /= HashSHA256
+    incompatibleWithDefaultCurve _ = False
+
+handshake_ciphersuites :: ([Cipher], [Cipher]) -> IO ()
+handshake_ciphersuites (clientCiphers, serverCiphers) = do
+    tls13 <- generate arbitrary
+    let version = if tls13 then TLS13 else TLS12
+    (clientParam, serverParam) <-
+        generate $
+            arbitraryPairParamsWithVersionsAndCiphers
+                ([version], [version])
+                (clientCiphers, serverCiphers)
+    let adequate = cipherAllowedForVersion version
+        shouldSucceed = any adequate (clientCiphers `intersect` serverCiphers)
+    if shouldSucceed
+        then runTLSSimple (clientParam, serverParam)
+        else runTLSFailure (clientParam, serverParam) handshake handshake
+
+--------------------------------------------------------------
+
+handshake_groups :: GGP -> IO ()
+handshake_groups (GGP clientGroups serverGroups) = do
+    tls13 <- generate arbitrary
+    let versions = if tls13 then [TLS13] else [TLS12]
+        ciphers = ciphersuite_strong
+    (clientParam, serverParam) <-
+        generate $
+            arbitraryPairParamsWithVersionsAndCiphers
+                (versions, versions)
+                (ciphers, ciphers)
+    denyCustom <- generate arbitrary
+    let groupUsage =
+            if denyCustom
+                then GroupUsageUnsupported "custom group denied"
+                else GroupUsageValid
+        clientParam' =
+            clientParam
+                { clientSupported =
+                    (clientSupported clientParam)
+                        { supportedGroups = clientGroups
+                        }
+                , clientHooks =
+                    (clientHooks clientParam)
+                        { onCustomFFDHEGroup = \_ _ -> return groupUsage
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverSupported =
+                    (serverSupported serverParam)
+                        { supportedGroups = serverGroups
+                        , supportedGroupsTLS13 = [serverGroups]
+                        }
+                }
+        commonGroups = clientGroups `intersect` serverGroups
+        shouldFail = null commonGroups
+        p minfo = isNothing (minfo >>= infoSupportedGroup) == null commonGroups
+    if shouldFail
+        then runTLSFailure (clientParam', serverParam') handshake handshake
+        else runTLSPredicate (clientParam', serverParam') p
+
+--------------------------------------------------------------
+
+newtype SG = SG [Group] deriving (Show)
+
+instance Arbitrary SG where
+    arbitrary = SG <$> shuffle sigGroups
+      where
+        sigGroups = [P256, P521]
+
+handshake_ec :: SG -> IO ()
+handshake_ec (SG sigGroups) = do
+    let versions = [TLS12]
+        ciphers =
+            [ cipher_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384
+            ]
+        hashSignatures =
+            [ (HashSHA256, SignatureECDSA)
+            ]
+    (clientParam, serverParam) <-
+        generate $
+            arbitraryPairParamsWithVersionsAndCiphers
+                (versions, versions)
+                (ciphers, ciphers)
+    clientGroups <- generate $ shuffle sigGroups
+    clientHashSignatures <- generate $ sublistOf hashSignatures
+    serverHashSignatures <- generate $ sublistOf hashSignatures
+    credentials <- generate arbitraryCredentialsOfEachCurve
+    let clientParam' =
+            clientParam
+                { clientSupported =
+                    (clientSupported clientParam)
+                        { supportedGroups = clientGroups
+                        , supportedHashSignatures = clientHashSignatures
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverSupported =
+                    (serverSupported serverParam)
+                        { supportedGroups = sigGroups
+                        , supportedGroupsTLS13 = [sigGroups]
+                        , supportedHashSignatures = serverHashSignatures
+                        }
+                , serverShared =
+                    (serverShared serverParam)
+                        { sharedCredentials = Credentials credentials
+                        }
+                }
+        sigAlgs = map snd (clientHashSignatures `intersect` serverHashSignatures)
+        ecdsaDenied = SignatureECDSA `notElem` sigAlgs
+    if ecdsaDenied
+        then runTLSFailure (clientParam', serverParam') handshake handshake
+        else runTLSSimple (clientParam', serverParam')
+
+-- Tests ability to use or ignore client "signature_algorithms" extension when
+-- choosing a server certificate.  Here peers allow DHE_RSA_AES128_SHA1 but
+-- the server RSA certificate has a SHA-1 signature that the client does not
+-- support.  Server may choose the DSA certificate only when cipher
+-- DHE_DSA_AES128_SHA1 is allowed.  Otherwise it must fallback to the RSA
+-- certificate.
+
+data OC = OC [Cipher] [Cipher] deriving (Show)
+
+instance Arbitrary OC where
+    arbitrary = OC <$> sublistOf otherCiphers <*> sublistOf otherCiphers
+      where
+        otherCiphers =
+            [ cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384
+            , cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256
+            ]
+
+handshake_cert_fallback_cipher :: OC -> IO ()
+handshake_cert_fallback_cipher (OC clientCiphers serverCiphers) = do
+    let clientVersions = [TLS12]
+        serverVersions = [TLS12]
+        commonCiphers = [cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256]
+        hashSignatures = [(HashSHA256, SignatureRSA), (HashSHA1, SignatureDSA)]
+    chainRef <- newIORef Nothing
+    (clientParam, serverParam) <-
+        generate $
+            arbitraryPairParamsWithVersionsAndCiphers
+                (clientVersions, serverVersions)
+                (clientCiphers ++ commonCiphers, serverCiphers ++ commonCiphers)
+    let clientParam' =
+            clientParam
+                { clientSupported =
+                    (clientSupported clientParam)
+                        { supportedHashSignatures = hashSignatures
+                        }
+                , clientHooks =
+                    (clientHooks clientParam)
+                        { onServerCertificate = \_ _ _ chain ->
+                            writeIORef chainRef (Just chain) >> return []
+                        }
+                }
+    runTLSSimple (clientParam', serverParam)
+    serverChain <- readIORef chainRef
+    isLeafRSA serverChain `shouldBe` True
+
+-- Same as above but testing with supportedHashSignatures directly instead of
+-- ciphers, and thus allowing TLS13.  Peers accept RSA with SHA-256 but the
+-- server RSA certificate has a SHA-1 signature.  When Ed25519 is allowed by
+-- both client and server, the Ed25519 certificate is selected.  Otherwise the
+-- server fallbacks to RSA.
+--
+-- Note: SHA-1 is supposed to be disallowed in X.509 signatures with TLS13
+-- unless client advertises explicit support.  Currently this is not enforced by
+-- the library, which is useful to test this scenario.  SHA-1 could be replaced
+-- by another algorithm.
+
+data OHS = OHS [HashAndSignatureAlgorithm] [HashAndSignatureAlgorithm]
+    deriving (Show)
+
+instance Arbitrary OHS where
+    arbitrary = OHS <$> sublistOf otherHS <*> sublistOf otherHS
+      where
+        otherHS = [(HashIntrinsic, SignatureEd25519)]
+
+handshake_cert_fallback_hs :: OHS -> IO ()
+handshake_cert_fallback_hs (OHS clientHS serverHS) = do
+    tls13 <- generate arbitrary
+    let versions = if tls13 then [TLS13] else [TLS12]
+        ciphers =
+            [ cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256
+            , cipher_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256
+            , cipher13_AES_128_GCM_SHA256
+            ]
+        commonHS =
+            [ (HashSHA256, SignatureRSA)
+            , (HashIntrinsic, SignatureRSApssRSAeSHA256)
+            ]
+    chainRef <- newIORef Nothing
+    (clientParam, serverParam) <-
+        generate $
+            arbitraryPairParamsWithVersionsAndCiphers
+                (versions, versions)
+                (ciphers, ciphers)
+    let clientParam' =
+            clientParam
+                { clientSupported =
+                    (clientSupported clientParam)
+                        { supportedHashSignatures = commonHS ++ clientHS
+                        }
+                , clientHooks =
+                    (clientHooks clientParam)
+                        { onServerCertificate = \_ _ _ chain ->
+                            writeIORef chainRef (Just chain) >> return []
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverSupported =
+                    (serverSupported serverParam)
+                        { supportedHashSignatures = commonHS ++ serverHS
+                        }
+                }
+        eddsaDisallowed =
+            (HashIntrinsic, SignatureEd25519) `notElem` clientHS
+                || (HashIntrinsic, SignatureEd25519) `notElem` serverHS
+    runTLSSimple (clientParam', serverParam')
+    serverChain <- readIORef chainRef
+    isLeafRSA serverChain `shouldBe` eddsaDisallowed
+
+--------------------------------------------------------------
+
+handshake_server_key_usage :: [ExtKeyUsageFlag] -> IO ()
+handshake_server_key_usage usageFlags = do
+    tls13 <- generate arbitrary
+    let versions = if tls13 then [TLS13] else [TLS12]
+        ciphers = ciphersuite_all
+    (clientParam, serverParam) <-
+        generate $
+            arbitraryPairParamsWithVersionsAndCiphers
+                (versions, versions)
+                (ciphers, ciphers)
+    cred <- generate $ arbitraryRSACredentialWithUsage usageFlags
+    let serverParam' =
+            serverParam
+                { serverShared =
+                    (serverShared serverParam)
+                        { sharedCredentials = Credentials [cred]
+                        }
+                }
+        shouldSucceed = KeyUsage_digitalSignature `elem` usageFlags
+    if shouldSucceed
+        then runTLSSimple (clientParam, serverParam')
+        else runTLSFailure (clientParam, serverParam') handshake handshake
+
+handshake_client_key_usage :: [ExtKeyUsageFlag] -> IO ()
+handshake_client_key_usage usageFlags = do
+    (clientParam, serverParam) <- generate arbitrary
+    cred <- generate $ arbitraryRSACredentialWithUsage usageFlags
+    let clientParam' =
+            clientParam
+                { clientHooks =
+                    (clientHooks clientParam)
+                        { onCertificateRequest = \_ -> return $ Just cred
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverWantClientCert = True
+                , serverHooks =
+                    (serverHooks serverParam)
+                        { onClientCertificate = \_ -> return CertificateUsageAccept
+                        }
+                }
+        shouldSucceed = KeyUsage_digitalSignature `elem` usageFlags
+    if shouldSucceed
+        then runTLSSimple (clientParam', serverParam')
+        else runTLSFailure (clientParam', serverParam') handshake handshake
+
+--------------------------------------------------------------
+
+handshake_client_auth :: (ClientParams, ServerParams) -> IO ()
+handshake_client_auth (clientParam, serverParam) = do
+    let clientVersions = supportedVersions $ clientSupported clientParam
+        serverVersions = supportedVersions $ serverSupported serverParam
+        version = maximum (clientVersions `intersect` serverVersions)
+    cred <- generate (arbitraryClientCredential version)
+    let clientParam' =
+            clientParam
+                { clientHooks =
+                    (clientHooks clientParam)
+                        { onCertificateRequest = \_ -> return $ Just cred
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverWantClientCert = True
+                , serverHooks =
+                    (serverHooks serverParam)
+                        { onClientCertificate = validateChain cred
+                        }
+                }
+    runTLSSimple (clientParam', serverParam')
+  where
+    validateChain cred chain
+        | chain == fst cred = return CertificateUsageAccept
+        | otherwise = return (CertificateUsageReject CertificateRejectUnknownCA)
+
+handshake_client_auth_fail :: (ClientParams, ServerParams) -> IO ()
+handshake_client_auth_fail (clientParam, serverParam) = do
+    let clientVersions = supportedVersions $ clientSupported clientParam
+        serverVersions = supportedVersions $ serverSupported serverParam
+        version = maximum (clientVersions `intersect` serverVersions)
+    cred <- generate (arbitraryClientCredential version)
+    let clientParam' =
+            clientParam
+                { clientHooks =
+                    (clientHooks clientParam)
+                        { onCertificateRequest = \_ -> return $ Just cred
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverWantClientCert = True
+                , serverHooks =
+                    (serverHooks serverParam)
+                        { onClientCertificate = validateChain cred
+                        }
+                }
+    runTLSFailure (clientParam', serverParam') handshake handshake
+  where
+    validateChain _ _ = return (CertificateUsageReject CertificateRejectUnknownCA)
+
+--------------------------------------------------------------
+
+handshake_ems :: (EMSMode, EMSMode) -> IO ()
+handshake_ems (cems, sems) = do
+    params <- generate arbitrary
+    let params' = setEMSMode (cems, sems) params
+        version = getConnectVersion params'
+        emsVersion = version >= TLS10 && version <= TLS12
+        use = cems /= NoEMS && sems /= NoEMS
+        require = cems == RequireEMS || sems == RequireEMS
+        p info = infoExtendedMainSecret info == (emsVersion && use)
+    if emsVersion && require && not use
+        then runTLSFailure params' handshake handshake
+        else runTLSPredicate params' (maybe False p)
+
+newtype CompatEMS = CompatEMS (EMSMode, EMSMode) deriving (Show)
+
+instance Arbitrary CompatEMS where
+    arbitrary = CompatEMS <$> (arbitrary `suchThat` compatible)
+      where
+        compatible (NoEMS, RequireEMS) = False
+        compatible (RequireEMS, NoEMS) = False
+        compatible _ = True
+
+handshake_resumption_ems :: (CompatEMS, CompatEMS) -> IO ()
+handshake_resumption_ems (CompatEMS ems, CompatEMS ems2) = do
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    plainParams <- generate arbitrary
+    let params =
+            setEMSMode ems $
+                setPairParamsSessionManagers sessionManagers plainParams
+
+    runTLSSimple params
+
+    -- and resume
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let params2 =
+            setEMSMode ems2 $
+                setPairParamsSessionResuming (fromJust sessionParams) params
+
+    let version = getConnectVersion params2
+        emsVersion = version >= TLS10 && version <= TLS12
+
+    if emsVersion && use ems && not (use ems2)
+        then runTLSFailure params2 handshake handshake
+        else do
+            runTLSSimple params2
+            mSessionParams2 <- readClientSessionRef sessionRefs
+            let sameSession = sessionParams == mSessionParams2
+                sameUse = use ems == use ems2
+            when emsVersion (sameSession `shouldBe` sameUse)
+  where
+    use (NoEMS, _) = False
+    use (_, NoEMS) = False
+    use _ = True
+
+--------------------------------------------------------------
+
+handshake_alpn :: (ClientParams, ServerParams) -> IO ()
+handshake_alpn (clientParam, serverParam) = do
+    let clientParam' =
+            clientParam
+                { clientHooks =
+                    (clientHooks clientParam)
+                        { onSuggestALPN = return $ Just ["h2", "http/1.1"]
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverHooks =
+                    (serverHooks serverParam)
+                        { onALPNClientSuggest = Just alpn
+                        }
+                }
+        params' = (clientParam', serverParam')
+    runTLSSuccess params' hsClient hsServer
+  where
+    hsClient ctx = do
+        handshake ctx
+        proto <- getNegotiatedProtocol ctx
+        proto `shouldBe` Just "h2"
+    hsServer ctx = do
+        handshake ctx
+        proto <- getNegotiatedProtocol ctx
+        proto `shouldBe` Just "h2"
+    alpn xs
+        | "h2" `elem` xs = return "h2"
+        | otherwise = return "http/1.1"
+
+handshake_sni :: (ClientParams, ServerParams) -> IO ()
+handshake_sni (clientParam, serverParam) = do
+    ref <- newIORef Nothing
+    let clientParam' =
+            clientParam
+                { clientServerIdentification = (serverName, "")
+                }
+        serverParam' =
+            serverParam
+                { serverHooks =
+                    (serverHooks serverParam)
+                        { onServerNameIndication = onSNI ref
+                        }
+                }
+        params' = (clientParam', serverParam')
+    runTLSSuccess params' hsClient hsServer
+    receivedName <- readIORef ref
+    receivedName `shouldBe` Just (Just serverName)
+  where
+    hsClient ctx = do
+        handshake ctx
+        msni <- getClientSNI ctx
+        expectMaybe "C: SNI should be Just" serverName msni
+    hsServer ctx = do
+        handshake ctx
+        msni <- getClientSNI ctx
+        expectMaybe "S: SNI should be Just" serverName msni
+    onSNI ref name = do
+        mx <- readIORef ref
+        mx `shouldBe` Nothing
+        writeIORef ref (Just name)
+        return (Credentials [])
+    serverName = "haskell.org"
+
+--------------------------------------------------------------
+
+newtype CSP12 = CSP12 (ClientParams, ServerParams) deriving (Show)
+
+instance Arbitrary CSP12 where
+    arbitrary = CSP12 <$> arbitraryPairParams12
+
+handshake12_renegotiation :: CSP12 -> IO ()
+handshake12_renegotiation (CSP12 (cparams, sparams)) = do
+    renegDisabled <- generate arbitrary
+    let sparams' =
+            sparams
+                { serverSupported =
+                    (serverSupported sparams)
+                        { supportedClientInitiatedRenegotiation = not renegDisabled
+                        }
+                }
+    if renegDisabled
+        then runTLSFailure (cparams, sparams') hsClient hsServer
+        else runTLSSimple (cparams, sparams')
+  where
+    hsClient ctx = handshake ctx >> handshake ctx
+    -- recvData receives the alert from the second handshake
+    hsServer ctx = handshake ctx >> void (recvData ctx)
+
+handshake12_session_resumption :: CSP12 -> IO ()
+handshake12_session_resumption (CSP12 plainParams) = do
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params = setPairParamsSessionManagers sessionManagers plainParams
+
+    runTLSSimple params
+
+    -- and resume
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let params2 = setPairParamsSessionResuming (fromJust sessionParams) params
+
+    runTLSPredicate params2 (maybe False infoTLS12Resumption)
+
+handshake12_session_ticket :: CSP12 -> IO ()
+handshake12_session_ticket (CSP12 plainParams) = do
+    sessionRefs <- twoSessionRefs
+    let sessionManagers0 = twoSessionManagers sessionRefs
+        sessionManagers = (fst sessionManagers0, oneSessionTicket)
+
+    let params = setPairParamsSessionManagers sessionManagers plainParams
+
+    runTLSSimple params
+
+    -- and resume
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let params2 = setPairParamsSessionResuming (fromJust sessionParams) params
+
+    runTLSPredicate params2 (maybe False infoTLS12Resumption)
+
+--------------------------------------------------------------
+
+handshake13_full :: CSP13 -> IO ()
+handshake13_full (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+    runTLSSimple13 params FullHandshake
+
+handshake13_hrr :: CSP13 -> IO ()
+handshake13_hrr (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+    runTLSSimple13 params HelloRetryRequest
+
+handshake13_psk :: CSP13 -> IO ()
+handshake13_psk (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params0 =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13 params HelloRetryRequest
+
+    -- and resume
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let params2 = setPairParamsSessionResuming (fromJust sessionParams) params
+
+    runTLSSimple13 params2 PreSharedKey
+
+handshake13_psk_ticket :: CSP13 -> IO ()
+handshake13_psk_ticket (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params0 =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers0 = twoSessionManagers sessionRefs
+        sessionManagers = (fst sessionManagers0, oneSessionTicket)
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13 params HelloRetryRequest
+
+    -- and resume
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let params2 = setPairParamsSessionResuming (fromJust sessionParams) params
+
+    runTLSSimple13 params2 PreSharedKey
+
+handshake13_psk_fallback :: CSP13 -> IO ()
+handshake13_psk_fallback (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers =
+                    [ cipher13_AES_128_GCM_SHA256
+                    , cipher13_AES_128_CCM_SHA256
+                    ]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        params0 =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13 params HelloRetryRequest
+
+    -- resumption fails because GCM cipher is not supported anymore, full
+    -- handshake is not possible because X25519 has been removed, so we are
+    -- back with P256 after hello retry
+    sessionParams <- readClientSessionRef sessionRefs
+    expectJust "session param should be Just" sessionParams
+    let (cli2, srv2) = setPairParamsSessionResuming (fromJust sessionParams) params
+        srv2' =
+            srv2{serverSupported = svrSupported'}
+        svrSupported' =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_CCM_SHA256]
+                , supportedGroups = [P256]
+                , supportedGroupsTLS13 = [[P256]]
+                }
+
+    runTLSSimple13 (cli2, srv2') HelloRetryRequest
+
+handshake13_0rtt :: CSP13 -> IO ()
+handshake13_0rtt (CSP13 (cli, srv)) = do
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [X25519]
+                , supportedGroupsTLS13 = [[X25519]]
+                }
+        cliHooks =
+            defaultClientHooks
+                { onSuggestALPN = return $ Just ["h2"]
+                }
+        svrHooks =
+            defaultServerHooks
+                { onALPNClientSuggest = Just (return . unsafeHead)
+                }
+        params0 =
+            ( cli
+                { clientSupported = cliSupported
+                , clientHooks = cliHooks
+                }
+            , srv
+                { serverSupported = svrSupported
+                , serverHooks = svrHooks
+                , serverEarlyDataSize = 2048
+                }
+            )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params = setPairParamsSessionManagers sessionManagers params0
+
+    runTLSSimple13 params HelloRetryRequest
+    runTLS0rtt params sessionRefs
+    runTLS0rtt params sessionRefs
+  where
+    runTLS0rtt params sessionRefs = do
+        -- and resume
+        sessionParams <- readClientSessionRef sessionRefs
+        expectJust "session param should be Just" sessionParams
+        clearClientSessionRef sessionRefs
+        earlyData <- B.pack <$> generate (someWords8 256)
+        let (pc, ps) = setPairParamsSessionResuming (fromJust sessionParams) params
+            params2 = (pc{clientUseEarlyData = True}, ps)
+
+        runTLS0RTT params2 RTT0 earlyData
+
+handshake13_0rtt_fallback :: CSP13 -> IO ()
+handshake13_0rtt_fallback (CSP13 (cli, srv)) = do
+    group0 <- generate $ elements [P256, X25519]
+    let cliSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [P256, X25519]
+                }
+        svrSupported =
+            defaultSupported
+                { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                , supportedGroups = [group0]
+                , supportedGroupsTLS13 = [[group0]]
+                }
+        params =
+            ( cli{clientSupported = cliSupported}
+            , srv
+                { serverSupported = svrSupported
+                , serverEarlyDataSize = 1024
+                }
+            )
+
+    sessionRefs <- twoSessionRefs
+    let sessionManagers = twoSessionManagers sessionRefs
+
+    let params0 = setPairParamsSessionManagers sessionManagers params
+
+    let mode = if group0 == P256 then FullHandshake else HelloRetryRequest
+    runTLSSimple13 params0 mode
+
+    -- and resume
+    mSessionParams <- readClientSessionRef sessionRefs
+    case mSessionParams of
+        Nothing -> expectationFailure "session params: Just is expected"
+        Just sessionParams -> do
+            earlyData <- B.pack <$> generate (someWords8 256)
+            group1 <- generate $ elements [P256, X25519]
+            let (pc, ps) = setPairParamsSessionResuming sessionParams params0
+                svrSupported1 =
+                    defaultSupported
+                        { supportedCiphers = [cipher13_AES_128_GCM_SHA256]
+                        , supportedGroups = [group1]
+                        , supportedGroupsTLS13 = [[group1]]
+                        }
+                params1 =
+                    ( pc{clientUseEarlyData = True}
+                    , ps
+                        { serverEarlyDataSize = 0
+                        , serverSupported = svrSupported1
+                        }
+                    )
+            -- C: [P256, X25519]
+            -- S: [group0]
+            -- C: [P256, X25519]
+            -- S: [group1]
+            if group0 == group1
+                -- 0-RTT is not allowed, so fallback to PreSharedKey
+                then runTLS0RTT params1 PreSharedKey earlyData
+                -- HRR but not allowed for 0-RTT
+                else runTLSFailure params1 (tlsClient earlyData) tlsServer
+  where
+    tlsClient earlyData ctx = do
+        handshake ctx
+        sendData ctx $ L.fromStrict earlyData
+        _ <- recvData ctx
+        bye ctx
+    tlsServer ctx = do
+        handshake ctx
+        _ <- recvData ctx
+        bye ctx
+
+handshake13_ee_groups :: CSP13 -> IO ()
+handshake13_ee_groups (CSP13 (cli, srv)) = do
+    let -- The client prefers P256
+        cliSupported = (clientSupported cli){supportedGroups = [P256, X25519]}
+        -- The server prefers X25519
+        svrSupported =
+            (serverSupported srv)
+                { supportedGroups = [X25519, P256]
+                , supportedGroupsTLS13 = [[X25519, P256]]
+                }
+        params =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+    (_, serverMessages) <- runTLSCapture13 params
+    -- The server should tell X25519 in supported_groups in EE to client
+    let isSupportedGroups (ExtensionRaw eid _) = eid == EID_SupportedGroups
+        eeMessagesHaveExt =
+            [ any isSupportedGroups exts
+            | EncryptedExtensions13 exts <- serverMessages
+            ]
+    eeMessagesHaveExt `shouldBe` [True]
+
+handshake13_ec :: CSP13 -> IO ()
+handshake13_ec (CSP13 (cli, srv)) = do
+    EC cgrps <- generate arbitrary
+    EC sgrps <- generate arbitrary
+    let cliSupported = (clientSupported cli){supportedGroups = cgrps}
+        svrSupported =
+            (serverSupported srv)
+                { supportedGroups = sgrps
+                , supportedGroupsTLS13 = [sgrps]
+                }
+        params =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+    runTLSSimple13 params FullHandshake
+
+handshake13_ffdhe :: CSP13 -> IO ()
+handshake13_ffdhe (CSP13 (cli, srv)) = do
+    FFDHE cgrps <- generate arbitrary
+    FFDHE sgrps <- generate arbitrary
+    let cliSupported = (clientSupported cli){supportedGroups = cgrps}
+        svrSupported =
+            (serverSupported srv)
+                { supportedGroups = sgrps
+                , supportedGroupsTLS13 = [sgrps]
+                }
+        params =
+            ( cli{clientSupported = cliSupported}
+            , srv{serverSupported = svrSupported}
+            )
+    runTLSSimple13 params FullHandshake
+
+post_handshake_auth :: CSP13 -> IO ()
+post_handshake_auth (CSP13 (clientParam, serverParam)) = do
+    cred <- generate (arbitraryClientCredential TLS13)
+    let clientParam' =
+            clientParam
+                { clientHooks =
+                    (clientHooks clientParam)
+                        { onCertificateRequest = \_ -> return $ Just cred
+                        }
+                }
+        serverParam' =
+            serverParam
+                { serverHooks =
+                    (serverHooks serverParam)
+                        { onClientCertificate = validateChain cred
+                        }
+                }
+    if isCredentialDSA cred
+        then runTLSFailure (clientParam', serverParam') hsClient hsServer
+        else runTLSSuccess (clientParam', serverParam') hsClient hsServer
+  where
+    validateChain cred chain
+        | chain == fst cred = return CertificateUsageAccept
+        | otherwise = return (CertificateUsageReject CertificateRejectUnknownCA)
+    hsClient ctx = do
+        handshake ctx
+        sendData ctx "request 1"
+        recvDataAssert ctx "response 1"
+        sendData ctx "request 2"
+        recvDataAssert ctx "response 2"
+    hsServer ctx = do
+        handshake ctx
+        recvDataAssert ctx "request 1"
+        _ <- requestCertificate ctx -- single request
+        sendData ctx "response 1"
+        recvDataAssert ctx "request 2"
+        _ <- requestCertificate ctx
+        _ <- requestCertificate ctx -- two simultaneously
+        sendData ctx "response 2"
+
+expectJust :: String -> Maybe a -> Expectation
+expectJust tag mx = case mx of
+    Nothing -> expectationFailure tag
+    Just _ -> return ()
diff --git a/test/PipeChan.hs b/test/PipeChan.hs
new file mode 100644
--- /dev/null
+++ b/test/PipeChan.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- create a similar concept than a unix pipe.
+module PipeChan (
+    PipeChan (..),
+    newPipe,
+    runPipe,
+    readPipeC,
+    readPipeS,
+    writePipeC,
+    writePipeS,
+) where
+
+import Control.Concurrent
+import Control.Monad (forever)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import Data.IORef
+
+----------------------------------------------------------------
+
+-- | represent a unidirectional pipe with a buffered read channel and
+-- a write channel
+data UniPipeChan = UniPipeChan
+    { getReadUniPipe :: Chan ByteString
+    , getWriteUniPipe :: Chan ByteString
+    }
+
+newUniPipeChan :: IO UniPipeChan
+newUniPipeChan = UniPipeChan <$> newChan <*> newChan
+
+runUniPipe :: UniPipeChan -> IO ThreadId
+runUniPipe UniPipeChan{..} =
+    forkIO $
+        forever $
+            readChan getReadUniPipe >>= writeChan getWriteUniPipe
+
+----------------------------------------------------------------
+
+-- | Represent a bidirectional pipe with 2 nodes A and B
+data PipeChan = PipeChan
+    { fromC :: IORef ByteString
+    , fromS :: IORef ByteString
+    , c2s :: UniPipeChan
+    , s2c :: UniPipeChan
+    }
+
+newPipe :: IO PipeChan
+newPipe =
+    PipeChan
+        <$> newIORef B.empty
+        <*> newIORef B.empty
+        <*> newUniPipeChan
+        <*> newUniPipeChan
+
+runPipe :: PipeChan -> IO (ThreadId, ThreadId)
+runPipe PipeChan{..} = (,) <$> runUniPipe c2s <*> runUniPipe s2c
+
+readPipeC :: PipeChan -> Int -> IO ByteString
+readPipeC PipeChan{..} sz = readBuffered fromS (getWriteUniPipe s2c) sz
+
+writePipeC :: PipeChan -> ByteString -> IO ()
+writePipeC PipeChan{..} = writeChan $ getWriteUniPipe c2s
+
+readPipeS :: PipeChan -> Int -> IO ByteString
+readPipeS PipeChan{..} sz = readBuffered fromC (getWriteUniPipe c2s) sz
+
+writePipeS :: PipeChan -> ByteString -> IO ()
+writePipeS PipeChan{..} = writeChan $ getReadUniPipe s2c
+
+-- helper to read buffered data.
+readBuffered :: IORef ByteString -> Chan ByteString -> Int -> IO ByteString
+readBuffered ref chan sz = do
+    left <- readIORef ref
+    if B.length left >= sz
+        then do
+            let (ret, nleft) = B.splitAt sz left
+            writeIORef ref nleft
+            return ret
+        else do
+            let newSize = sz - B.length left
+            newData <- readChan chan
+            writeIORef ref newData
+            remain <- readBuffered ref chan newSize
+            return (left `B.append` remain)
diff --git a/test/PubKey.hs b/test/PubKey.hs
new file mode 100644
--- /dev/null
+++ b/test/PubKey.hs
@@ -0,0 +1,123 @@
+module PubKey (
+    arbitraryRSAPair,
+    arbitraryDSAPair,
+    arbitraryECDSAPair,
+    arbitraryEd25519Pair,
+    arbitraryEd448Pair,
+    globalRSAPair,
+    getGlobalRSAPair,
+    knownECCurves,
+    defaultECCurve,
+    dsaParams,
+    rsaParams,
+) where
+
+import Control.Concurrent.MVar
+import Crypto.Error
+import qualified Crypto.PubKey.DSA as DSA
+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+import qualified Crypto.PubKey.ECC.Prim as ECC
+import qualified Crypto.PubKey.ECC.Types as ECC
+import qualified Crypto.PubKey.Ed25519 as Ed25519
+import qualified Crypto.PubKey.Ed448 as Ed448
+import qualified Crypto.PubKey.RSA as RSA
+import Crypto.Random
+import qualified Data.ByteString as B
+import System.IO.Unsafe
+import Test.QuickCheck
+
+arbitraryRSAPair :: Gen (RSA.PublicKey, RSA.PrivateKey)
+arbitraryRSAPair = (rngToRSA . drgNewTest) `fmap` arbitrary
+  where
+    rngToRSA :: ChaChaDRG -> (RSA.PublicKey, RSA.PrivateKey)
+    rngToRSA rng = fst $ withDRG rng arbitraryRSAPairWithRNG
+
+arbitraryRSAPairWithRNG :: MonadRandom m => m (RSA.PublicKey, RSA.PrivateKey)
+arbitraryRSAPairWithRNG = RSA.generate 256 0x10001
+
+{-# NOINLINE globalRSAPair #-}
+globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)
+globalRSAPair = unsafePerformIO $ do
+    drg <- drgNew
+    newMVar (fst $ withDRG drg arbitraryRSAPairWithRNG)
+
+{-# NOINLINE getGlobalRSAPair #-}
+getGlobalRSAPair :: (RSA.PublicKey, RSA.PrivateKey)
+getGlobalRSAPair = unsafePerformIO (readMVar globalRSAPair)
+
+rsaParams :: (RSA.PublicKey, RSA.PrivateKey)
+rsaParams = (pub, priv)
+  where
+    priv =
+        RSA.PrivateKey
+            { RSA.private_pub = pub
+            , RSA.private_d = d
+            , RSA.private_p = 0
+            , RSA.private_q = 0
+            , RSA.private_dP = 0
+            , RSA.private_dQ = 0
+            , RSA.private_qinv = 0
+            }
+    pub =
+        RSA.PublicKey
+            { RSA.public_size = 1024 `div` 8
+            , RSA.public_n = n
+            , RSA.public_e = e
+            }
+    n =
+        0x00c086b4c6db28ae578d73766d6fdd04b913808a85bf9ad7bcfc9a6ff04d13d2ff75f761ce7db9ee8996e29dc433d19a2d3f748e8d368ba099781d58276e1863a324ae3fb1a061874cd9f3510e54e49727c68de0616964335371cfb63f15ebff8ce8df09c74fb8625f8f58548b90f079a3405f522e738e664d0c645b015664f7c7
+    e = 0x10001
+    d =
+        0x3edc3cae28e4717818b1385ba7088d0038c3e176a606d2a5dbfc38cc46fe500824e62ec312fde04a803f61afac13a5b95c5c9c26b346879b54429083df488b4f29bb7b9722d366d6f5d2b512150a2e950eacfe0fd9dd56b87b0322f74ae3c8d8674ace62bc723f7c05e9295561efd70d7a924c6abac2e482880fc0149d5ad481
+
+dsaParams :: DSA.Params
+dsaParams =
+    DSA.Params
+        { DSA.params_p =
+            0x009f356bbc4750645555b02aa3918e85d5e35bdccd56154bfaa3e1801d5fe0faf65355215148ea866d5732fd27eb2f4d222c975767d2eb573513e460eceae327c8ac5da1f4ce765c49a39cae4c904b4e5cc64554d97148f20a2655027a0cf8f70b2550cc1f0c9861ce3a316520ab0588407ea3189d20c78bd52df97e56cbe0bbeb
+        , DSA.params_q = 0x00f33a57b47de86ff836f9fe0bb060c54ab293133b
+        , DSA.params_g =
+            0x3bb973c4f6eee92d1530f250487735595d778c2e5c8147d67a46ebcba4e6444350d49da8e7da667f9b1dbb22d2108870b9fcfabc353cdfac5218d829f22f69130317cc3b0d724881e34c34b8a2571d411da6458ef4c718df9e826f73e16a035b1dcbc1c62cac7a6604adb3e7930be8257944c6dfdddd655004b98253185775ff
+        }
+
+arbitraryDSAPair :: Gen (DSA.PublicKey, DSA.PrivateKey)
+arbitraryDSAPair = do
+    priv <- choose (1, DSA.params_q dsaParams)
+    let pub = DSA.calculatePublic dsaParams priv
+    return (DSA.PublicKey dsaParams pub, DSA.PrivateKey dsaParams priv)
+
+-- for performance reason P521 is not tested
+knownECCurves :: [ECC.CurveName]
+knownECCurves =
+    [ ECC.SEC_p256r1
+    , ECC.SEC_p384r1
+    , ECC.SEC_p521r1
+    ]
+
+defaultECCurve :: ECC.CurveName
+defaultECCurve = ECC.SEC_p256r1
+
+arbitraryECDSAPair :: ECC.CurveName -> Gen (ECDSA.PublicKey, ECDSA.PrivateKey)
+arbitraryECDSAPair curveName = do
+    d <- choose (1, n - 1)
+    let p = ECC.pointBaseMul curve d
+    return (ECDSA.PublicKey curve p, ECDSA.PrivateKey curve d)
+  where
+    curve = ECC.getCurveByName curveName
+    n = ECC.ecc_n . ECC.common_curve $ curve
+
+arbitraryEd25519Pair :: Gen (Ed25519.PublicKey, Ed25519.SecretKey)
+arbitraryEd25519Pair = do
+    bytes <- vectorOf 32 arbitrary
+    let priv = fromCryptoPassed $ Ed25519.secretKey (B.pack bytes)
+    return (Ed25519.toPublic priv, priv)
+
+arbitraryEd448Pair :: Gen (Ed448.PublicKey, Ed448.SecretKey)
+arbitraryEd448Pair = do
+    bytes <- vectorOf 57 arbitrary
+    let priv = fromCryptoPassed $ Ed448.secretKey (B.pack bytes)
+    return (Ed448.toPublic priv, priv)
+
+fromCryptoPassed :: CryptoFailable a -> a
+fromCryptoPassed (CryptoPassed x) = x
+fromCryptoPassed _ = error "fromCryptoPassed"
diff --git a/test/Run.hs b/test/Run.hs
new file mode 100644
--- /dev/null
+++ b/test/Run.hs
@@ -0,0 +1,394 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Run (
+    runTLS,
+    runTLSSimple,
+    runTLSPredicate,
+    runTLSSimple13,
+    runTLSSimple13ECH,
+    runTLS0RTT,
+    runTLS0RTTech,
+    runTLSSimpleKeyUpdate,
+    runTLSCaptureFail,
+    runTLSCapture13,
+    runTLSSuccess,
+    runTLSFailure,
+    expectMaybe,
+    newPairContext,
+    withDataPipe,
+    byeBye,
+) where
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import qualified Control.Exception as E
+import Control.Monad
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import Data.IORef
+import Network.TLS
+import System.Timeout
+import Test.Hspec
+import Test.QuickCheck
+
+import API
+import Arbitrary
+import PipeChan
+
+type ClinetWithInput = Chan ByteString -> Context -> IO ()
+type ServerWithOutput = Context -> Chan [ByteString] -> IO ()
+
+----------------------------------------------------------------
+
+runTLS
+    :: (ClientParams, ServerParams)
+    -> ClinetWithInput
+    -> ServerWithOutput
+    -> IO ()
+runTLS = runTLSN 1
+
+runTLSN
+    :: Int
+    -> (ClientParams, ServerParams)
+    -> ClinetWithInput
+    -> ServerWithOutput
+    -> IO ()
+runTLSN n params tlsClient tlsServer = do
+    inputChan <- newChan
+    outputChan <- newChan
+    -- generate some data to send
+    ds <- replicateM n $ B.pack <$> generate (someWords8 256)
+    forM_ ds $ writeChan inputChan
+    -- run client and server
+    withPairContext params $ \(cCtx, sCtx) ->
+        concurrently_ (server sCtx outputChan) (client inputChan cCtx)
+    -- read result
+    mDs <- timeout 1000000 $ readChan outputChan -- 60 sec
+    expectMaybe "timeout" ds mDs
+  where
+    server sCtx outputChan =
+        E.catch
+            (tlsServer sCtx outputChan)
+            (printAndRaise "S: " (serverSupported $ snd params))
+    client inputChan cCtx =
+        E.catch
+            (tlsClient inputChan cCtx)
+            (printAndRaise "C: " (clientSupported $ fst params))
+    printAndRaise :: String -> Supported -> E.SomeException -> IO ()
+    printAndRaise s supported e = do
+        putStrLn $
+            s
+                ++ " exception: "
+                ++ show e
+                ++ ", supported: "
+                ++ show supported
+        E.throwIO e
+
+----------------------------------------------------------------
+
+runTLSSimple :: (ClientParams, ServerParams) -> IO ()
+runTLSSimple params = runTLSPredicate params (const True)
+
+runTLSPredicate
+    :: (ClientParams, ServerParams) -> (Maybe Information -> Bool) -> IO ()
+runTLSPredicate params p = runTLSSuccess params hsClient hsServer
+  where
+    hsClient ctx = do
+        handshake ctx
+        checkInfoPredicate ctx
+    hsServer ctx = do
+        handshake ctx
+        checkInfoPredicate ctx
+    checkInfoPredicate ctx = do
+        minfo <- contextGetInformation ctx
+        unless (p minfo) $
+            fail ("unexpected information: " ++ show minfo)
+
+----------------------------------------------------------------
+
+runTLSSimple13
+    :: (ClientParams, ServerParams)
+    -> HandshakeMode13
+    -> IO ()
+runTLSSimple13 params mode =
+    runTLSSuccess params hsClient hsServer
+  where
+    hsClient ctx = do
+        handshake ctx
+        mmode <- (>>= infoTLS13HandshakeMode) <$> contextGetInformation ctx
+        expectMaybe "C: mode should be Just" mode mmode
+    hsServer ctx = do
+        handshake ctx
+        mmode <- (>>= infoTLS13HandshakeMode) <$> contextGetInformation ctx
+        expectMaybe "S: mode should be Just" mode mmode
+
+runTLSSimple13ECH
+    :: (ClientParams, ServerParams)
+    -> HandshakeMode13
+    -> IO ()
+runTLSSimple13ECH params mode =
+    runTLSSuccess params hsClient hsServer
+  where
+    hsClient ctx = do
+        handshake ctx
+        minfo <- contextGetInformation ctx
+        let mmode = minfo >>= infoTLS13HandshakeMode
+            maccepted = infoIsECHAccepted <$> minfo
+        expectMaybe "C: mode should be Just" mode mmode
+        expectMaybe "C: TLS accepted should be Just" True maccepted
+    hsServer ctx = do
+        handshake ctx
+        mmode <- (>>= infoTLS13HandshakeMode) <$> contextGetInformation ctx
+        expectMaybe "S: mode should be Just" mode mmode
+
+runTLS0RTT
+    :: (ClientParams, ServerParams)
+    -> HandshakeMode13
+    -> ByteString
+    -> IO ()
+runTLS0RTT params mode earlyData =
+    withPairContext params $ \(cCtx, sCtx) ->
+        concurrently_ (tlsServer sCtx) (tlsClient cCtx)
+  where
+    tlsClient ctx = do
+        handshake ctx
+        sendData ctx $ L.fromStrict earlyData
+        _ <- recvData ctx
+        bye ctx
+        mmode <- (>>= infoTLS13HandshakeMode) <$> contextGetInformation ctx
+        expectMaybe "C: mode should be Just" mode mmode
+    tlsServer ctx = do
+        handshake ctx
+        let ls = chunkLengths $ B.length earlyData
+        chunks <- replicateM (length ls) $ recvData ctx
+        (map B.length chunks, B.concat chunks) `shouldBe` (ls, earlyData)
+        sendData ctx $ L.fromStrict earlyData
+        bye ctx
+        mmode <- (>>= infoTLS13HandshakeMode) <$> contextGetInformation ctx
+        expectMaybe "S: mode should be Just" mode mmode
+    chunkLengths :: Int -> [Int]
+    chunkLengths len
+        | len > 16384 = 16384 : chunkLengths (len - 16384)
+        | len > 0 = [len]
+        | otherwise = []
+
+runTLS0RTTech
+    :: (ClientParams, ServerParams)
+    -> HandshakeMode13
+    -> ByteString
+    -> IO ()
+runTLS0RTTech params mode earlyData =
+    withPairContext params $ \(cCtx, sCtx) ->
+        concurrently_ (tlsServer sCtx) (tlsClient cCtx)
+  where
+    tlsClient ctx = do
+        handshake ctx
+        sendData ctx $ L.fromStrict earlyData
+        _ <- recvData ctx
+        bye ctx
+        minfo <- contextGetInformation ctx
+        let mmode = minfo >>= infoTLS13HandshakeMode
+            maccepted = infoIsECHAccepted <$> minfo
+        expectMaybe "C: mode should be Just" mode mmode
+        expectMaybe "C: TLS accepted should be Just" True maccepted
+    tlsServer ctx = do
+        handshake ctx
+        let ls = chunkLengths $ B.length earlyData
+        chunks <- replicateM (length ls) $ recvData ctx
+        (map B.length chunks, B.concat chunks) `shouldBe` (ls, earlyData)
+        sendData ctx $ L.fromStrict earlyData
+        bye ctx
+        mmode <- (>>= infoTLS13HandshakeMode) <$> contextGetInformation ctx
+        expectMaybe "S: mode should be Just" mode mmode
+    chunkLengths :: Int -> [Int]
+    chunkLengths len
+        | len > 16384 = 16384 : chunkLengths (len - 16384)
+        | len > 0 = [len]
+        | otherwise = []
+
+expectMaybe :: (Show a, Eq a) => String -> a -> Maybe a -> Expectation
+expectMaybe tag e mx = case mx of
+    Nothing -> expectationFailure tag
+    Just x -> x `shouldBe` e
+
+runTLSCaptureFail
+    :: (ClientParams, ServerParams) -> IO ([Handshake], [Handshake])
+runTLSCaptureFail params = do
+    sRef <- newIORef []
+    cRef <- newIORef []
+    runTLSFailure params (hsClient cRef) (hsServer sRef)
+    sReceived <- readIORef sRef
+    cReceived <- readIORef cRef
+    return (reverse sReceived, reverse cReceived)
+  where
+    hsClient ref ctx = do
+        installHook ctx ref
+        handshake ctx
+        sendData ctx "Foo"
+    hsServer ref ctx = do
+        installHook ctx ref
+        handshake ctx
+        _ <- recvData ctx
+        return ()
+    installHook ctx ref =
+        let recv hss = modifyIORef ref (hss :) >> return hss
+         in contextHookSetHandshakeRecv ctx recv
+
+runTLSCapture13
+    :: (ClientParams, ServerParams) -> IO ([Handshake13], [Handshake13])
+runTLSCapture13 params = do
+    sRef <- newIORef []
+    cRef <- newIORef []
+    runTLSSuccess params (hsClient cRef) (hsServer sRef)
+    sReceived <- readIORef sRef
+    cReceived <- readIORef cRef
+    return (reverse sReceived, reverse cReceived)
+  where
+    hsClient ref ctx = do
+        installHook ctx ref
+        handshake ctx
+    hsServer ref ctx = do
+        installHook ctx ref
+        handshake ctx
+    installHook ctx ref =
+        let recv hss = modifyIORef ref (hss :) >> return hss
+         in contextHookSetHandshake13Recv ctx recv
+
+runTLSSimpleKeyUpdate :: (ClientParams, ServerParams) -> IO ()
+runTLSSimpleKeyUpdate params = runTLSN 3 params tlsClient tlsServer
+  where
+    tlsClient queue ctx = do
+        handshake ctx
+        d0 <- readChan queue
+        sendData ctx (L.fromChunks [d0])
+        d1 <- readChan queue
+        sendData ctx (L.fromChunks [d1])
+        req <- generate $ elements [OneWay, TwoWay]
+        _ <- updateKey ctx req
+        d2 <- readChan queue
+        sendData ctx (L.fromChunks [d2])
+        checkCtxFinished ctx
+        bye ctx
+    tlsServer ctx queue = do
+        handshake ctx
+        d0 <- recvData ctx
+        req <- generate $ elements [OneWay, TwoWay]
+        _ <- updateKey ctx req
+        d1 <- recvData ctx
+        d2 <- recvData ctx
+        writeChan queue [d0, d1, d2]
+        checkCtxFinished ctx
+        bye ctx
+
+----------------------------------------------------------------
+
+runTLSSuccess
+    :: (ClientParams, ServerParams)
+    -> (Context -> IO ())
+    -> (Context -> IO ())
+    -> IO ()
+runTLSSuccess params hsClient hsServer = runTLS params tlsClient tlsServer
+  where
+    tlsClient queue ctx = do
+        hsClient ctx
+        d <- readChan queue
+        sendData ctx (L.fromChunks [d])
+        checkCtxFinished ctx
+        bye ctx
+    tlsServer ctx queue = do
+        hsServer ctx
+        d <- recvData ctx
+        writeChan queue [d]
+        checkCtxFinished ctx
+        bye ctx
+
+runTLSFailure
+    :: (ClientParams, ServerParams)
+    -> (Context -> IO c)
+    -> (Context -> IO s)
+    -> IO ()
+runTLSFailure params hsClient hsServer =
+    withPairContext params $ \(cCtx, sCtx) ->
+        concurrently_ (tlsServer sCtx) (tlsClient cCtx)
+  where
+    tlsClient ctx = hsClient ctx `shouldThrow` anyTLSException
+    tlsServer ctx = hsServer ctx `shouldThrow` anyTLSException
+
+anyTLSException :: Selector TLSException
+anyTLSException = const True
+
+----------------------------------------------------------------
+
+debug :: Bool
+debug = False
+
+withPairContext
+    :: (ClientParams, ServerParams) -> ((Context, Context) -> IO ()) -> IO ()
+withPairContext params body =
+    E.bracket
+        (newPairContext params)
+        (\((t1, t2), _) -> killThread t1 >> killThread t2)
+        (\(_, ctxs) -> body ctxs)
+
+newPairContext
+    :: (ClientParams, ServerParams)
+    -> IO ((ThreadId, ThreadId), (Context, Context))
+newPairContext (cParams, sParams) = do
+    pipe <- newPipe
+    tids <- runPipe pipe
+    let noFlush = return ()
+    let noClose = return ()
+
+    let cBackend = Backend noFlush noClose (writePipeC pipe) (readPipeC pipe)
+    let sBackend = Backend noFlush noClose (writePipeS pipe) (readPipeS pipe)
+    cCtx' <- contextNew cBackend cParams
+    sCtx' <- contextNew sBackend sParams
+
+    contextHookSetLogging cCtx' (logging "client: ")
+    contextHookSetLogging sCtx' (logging "server: ")
+
+    return (tids, (cCtx', sCtx'))
+  where
+    logging pre =
+        if debug
+            then
+                defaultLogging
+                    { loggingPacketSent = putStrLn . ((pre ++ ">> ") ++)
+                    , loggingPacketRecv = putStrLn . ((pre ++ "<< ") ++)
+                    }
+            else defaultLogging
+
+
+withDataPipe :: (ClientParams, ServerParams) -> (Context -> Chan result -> IO ()) -> (Chan start -> Context -> IO ()) -> ((start -> IO (), IO result) -> IO a) -> IO a
+withDataPipe params tlsServer tlsClient cont = do
+    -- initial setup
+    startQueue  <- newChan
+    resultQueue <- newChan
+
+    (cCtx, sCtx) <- snd <$> newPairContext params
+
+    withAsync (E.catch (tlsServer sCtx resultQueue)
+                       (printAndRaise "server" (serverSupported $ snd params))) $ \sAsync -> withAsync (E.catch (tlsClient startQueue cCtx)
+                                (printAndRaise "client" (clientSupported $ fst params))) $ \cAsync -> do
+      let readResult = waitBoth cAsync sAsync >> readChan resultQueue
+      cont (writeChan startQueue, readResult)
+
+  where
+        printAndRaise :: String -> Supported -> E.SomeException -> IO ()
+        printAndRaise s supported e = do
+            putStrLn $ s ++ " exception: " ++ show e ++
+                            ", supported: " ++ show supported
+            E.throwIO e
+
+-- Terminate the write direction and wait to receive the peer EOF.  This is
+-- necessary in situations where we want to confirm the peer status, or to make
+-- sure to receive late messages like session tickets.  In the test suite this
+-- is used each time application code ends the connection without prior call to
+-- 'recvData'.
+byeBye :: Context -> IO ()
+byeBye ctx = do
+    bye ctx
+    bs <- recvData ctx
+    unless (B.null bs) $ fail "byeBye: unexpected application data"
diff --git a/test/Session.hs b/test/Session.hs
new file mode 100644
--- /dev/null
+++ b/test/Session.hs
@@ -0,0 +1,92 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Session (
+    readClientSessionRef,
+    clearClientSessionRef,
+    twoSessionRefs,
+    twoSessionManagers,
+    setPairParamsSessionManagers,
+    setPairParamsSessionResuming,
+    oneSessionTicket,
+) where
+
+import Codec.Serialise
+import Control.Monad
+import qualified Data.ByteString.Lazy as L
+import Data.IORef
+import Network.TLS
+import Network.TLS.Internal
+
+----------------------------------------------------------------
+
+readClientSessionRef :: (IORef (Maybe c), IORef (Maybe s)) -> IO (Maybe c)
+readClientSessionRef refs = readIORef (fst refs)
+
+clearClientSessionRef :: (IORef (Maybe c), IORef (Maybe s)) -> IO ()
+clearClientSessionRef refs = writeIORef (fst refs) Nothing
+
+twoSessionRefs :: IO (IORef (Maybe client), IORef (Maybe server))
+twoSessionRefs = (,) <$> newIORef Nothing <*> newIORef Nothing
+
+-- | simple session manager to store one session id and session data for a single thread.
+-- a Real concurrent session manager would use an MVar and have multiples items.
+oneSessionManager :: IORef (Maybe (SessionID, SessionData)) -> SessionManager
+oneSessionManager ref =
+    noSessionManager
+        { sessionResume = \myId -> readIORef ref >>= maybeResume False myId
+        , sessionResumeOnlyOnce = \myId -> readIORef ref >>= maybeResume True myId
+        , sessionEstablish = \myId dat -> writeIORef ref (Just (myId, dat)) >> return Nothing
+        , sessionInvalidate = \_ -> return ()
+        , sessionUseTicket = False
+        }
+  where
+    maybeResume onlyOnce myId (Just (sid, sdata))
+        | sid == myId = when onlyOnce (writeIORef ref Nothing) >> return (Just sdata)
+    maybeResume _ _ _ = return Nothing
+
+twoSessionManagers
+    :: (IORef (Maybe (SessionID, SessionData)), IORef (Maybe (SessionID, SessionData)))
+    -> (SessionManager, SessionManager)
+twoSessionManagers (cRef, sRef) = (oneSessionManager cRef, oneSessionManager sRef)
+
+setPairParamsSessionManagers
+    :: (SessionManager, SessionManager)
+    -> (ClientParams, ServerParams)
+    -> (ClientParams, ServerParams)
+setPairParamsSessionManagers (clientManager, serverManager) (clientParams, serverParams) = (nc, ns)
+  where
+    nc =
+        clientParams
+            { clientShared = updateSessionManager clientManager $ clientShared clientParams
+            }
+    ns =
+        serverParams
+            { serverShared = updateSessionManager serverManager $ serverShared serverParams
+            }
+    updateSessionManager manager shared = shared{sharedSessionManager = manager}
+
+----------------------------------------------------------------
+
+setPairParamsSessionResuming
+    :: (SessionID, SessionData)
+    -> (ClientParams, ServerParams)
+    -> (ClientParams, ServerParams)
+setPairParamsSessionResuming sessionStuff (clientParams, serverParams) =
+    ( clientParams{clientWantSessionResume = Just sessionStuff}
+    , serverParams
+    )
+
+oneSessionTicket :: SessionManager
+oneSessionTicket =
+    noSessionManager
+        { sessionResume = resume
+        , sessionResumeOnlyOnce = resume
+        , sessionEstablish = \_ dat -> return $ Just $ L.toStrict $ serialise dat
+        , sessionInvalidate = \_ -> return ()
+        , sessionUseTicket = True
+        }
+
+resume :: Ticket -> IO (Maybe SessionData)
+resume ticket
+    | isTicket ticket = return $ Just $ deserialise $ L.fromStrict ticket
+    | otherwise = return Nothing
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/test/ThreadSpec.hs b/test/ThreadSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ThreadSpec.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ThreadSpec where
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as L
+import Data.Foldable (traverse_)
+import Network.TLS
+import Test.Hspec
+import Test.Hspec.QuickCheck
+
+import API
+import Arbitrary ()
+import Run
+
+spec :: Spec
+spec = do
+    describe "thread safety" $ do
+        prop "can read/write concurrently" $ \params ->
+            runTLS params tlsClient tlsServer
+
+tlsClient :: Chan ByteString -> Context -> IO ()
+tlsClient queue ctx = do
+    handshake ctx
+    runReaderWriters ctx "server-value" "client-value"
+    d <- readChan queue
+    sendData ctx (L.fromChunks [d])
+    checkCtxFinished ctx
+    bye ctx
+
+tlsServer :: Context -> Chan [ByteString] -> IO ()
+tlsServer ctx queue = do
+    handshake ctx
+    runReaderWriters ctx "client-value" "server-value"
+    d <- recvData ctx
+    writeChan queue [d]
+    checkCtxFinished ctx
+    bye ctx
+
+runReaderWriters :: Context -> ByteString -> L.ByteString -> IO ()
+runReaderWriters ctx r w =
+    -- run concurrently 10 readers and 10 writers on the same context
+    let workers = concat $ replicate 10 [recvDataAssert ctx r, sendData ctx w]
+     in runConcurrently $ traverse_ Concurrently workers
diff --git a/tls.cabal b/tls.cabal
--- a/tls.cabal
+++ b/tls.cabal
@@ -1,154 +1,280 @@
-Name:                tls
-Version:             1.2.8
-Description:
-   Native Haskell TLS and SSL protocol implementation for server and client.
-   .
-   This provides a high-level implementation of a sensitive security protocol,
-   eliminating a common set of security issues through the use of the advanced
-   type system, high level constructions and common Haskell features.
-   .
-   Currently implement the SSL3.0, TLS1.0, TLS1.1 and TLS1.2 protocol,
-   and support RSA and Ephemeral Diffie Hellman key exchanges,
-   and many extensions.
-   .
-   Some debug tools linked with tls, are available through the
-   <http://hackage.haskell.org/package/tls-debug/>.
-License:             BSD3
-License-file:        LICENSE
-Copyright:           Vincent Hanquez <vincent@snarc.org>
-Author:              Vincent Hanquez <vincent@snarc.org>
-Maintainer:          Vincent Hanquez <vincent@snarc.org>
-Synopsis:            TLS/SSL protocol native implementation (Server and Client)
-Build-Type:          Simple
-Category:            Network
-stability:           experimental
-Cabal-Version:       >=1.8
-Homepage:            http://github.com/vincenthz/hs-tls
-extra-source-files:  Tests/*.hs
-                     CHANGELOG.md
+cabal-version:      >=1.10
+name:               tls
+version:            2.4.3
+license:            BSD3
+license-file:       LICENSE
+copyright:          Vincent Hanquez <vincent@snarc.org>
+maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>
+author:             Vincent Hanquez <vincent@snarc.org>
+homepage:           https://github.com/haskell-tls/hs-tls
+synopsis:           TLS protocol native implementation
+description:
+    Native Haskell TLS 1.2/1.3 protocol implementation for servers and clients.
 
-Flag compat
-  Description:       Accept SSLv2 compatible handshake
-  Default:           True
+category:           Network
+build-type:         Simple
+extra-source-files:
+    test/*.hs
+    CHANGELOG.md
 
-Library
-  Build-Depends:     base >= 3 && < 5
-                   , mtl
-                   , cereal >= 0.4
-                   , bytestring
-                   , byteable
-                   , network
-                   , data-default-class
-                   -- crypto related
-                   , cryptohash >= 0.6
-                   , crypto-random >= 0.0 && < 0.1
-                   , crypto-numbers
-                   , crypto-cipher-types >= 0.0.8
-                   , crypto-pubkey >= 0.2.4
-                   , crypto-pubkey-types >= 0.4
-                   , cipher-rc4
-                   , cipher-des
-                   , cipher-aes >= 0.2 && < 0.3
-                   -- certificate related
-                   , asn1-types >= 0.2.0
-                   , asn1-encoding
-                   , x509 >= 1.4.3 && < 1.5.0
-                   , x509-store >= 1.4.4
-                   , x509-validation >= 1.5.0 && < 1.6.0
-  Exposed-modules:   Network.TLS
-                     Network.TLS.Cipher
-                     Network.TLS.Compression
-                     Network.TLS.Internal
-                     Network.TLS.Extra
-                     Network.TLS.Extra.Cipher
-  other-modules:     Network.TLS.Cap
-                     Network.TLS.Struct
-                     Network.TLS.Core
-                     Network.TLS.Context
-                     Network.TLS.Context.Internal
-                     Network.TLS.Credentials
-                     Network.TLS.Backend
-                     Network.TLS.Crypto
-                     Network.TLS.Crypto.DH
-                     Network.TLS.Extension
-                     Network.TLS.Handshake
-                     Network.TLS.Handshake.Common
-                     Network.TLS.Handshake.Certificate
-                     Network.TLS.Handshake.Key
-                     Network.TLS.Handshake.Client
-                     Network.TLS.Handshake.Server
-                     Network.TLS.Handshake.Process
-                     Network.TLS.Handshake.Signature
-                     Network.TLS.Handshake.State
-                     Network.TLS.Hooks
-                     Network.TLS.IO
-                     Network.TLS.MAC
-                     Network.TLS.Measurement
-                     Network.TLS.Packet
-                     Network.TLS.Parameters
-                     Network.TLS.Record
-                     Network.TLS.Record.Types
-                     Network.TLS.Record.Engage
-                     Network.TLS.Record.Disengage
-                     Network.TLS.Record.State
-                     Network.TLS.RNG
-                     Network.TLS.State
-                     Network.TLS.Session
-                     Network.TLS.Sending
-                     Network.TLS.Receiving
-                     Network.TLS.Util
-                     Network.TLS.Util.ASN1
-                     Network.TLS.Util.Serialization
-                     Network.TLS.Types
-                     Network.TLS.Wire
-                     Network.TLS.X509
-  ghc-options:       -Wall -fwarn-tabs
-  if impl(ghc == 7.6.1)
-    ghc-options:     -O0
-  if flag(compat)
-    cpp-options:     -DSSLV2_COMPATIBLE
+source-repository head
+    type:     git
+    location: https://github.com/haskell-tls/hs-tls
+    subdir:   tls
 
-Test-Suite test-tls
-  type:              exitcode-stdio-1.0
-  hs-source-dirs:    Tests
-  Main-is:           Tests.hs
-  Build-Depends:     base >= 3 && < 5
-                   , mtl
-                   , cereal >= 0.3
-                   , data-default-class
-                   , QuickCheck >= 2
-                   , test-framework
-                   , test-framework-quickcheck2
-                   , cprng-aes >= 0.5
-                   , crypto-pubkey >= 0.2
-                   , bytestring
-                   , x509
-                   , x509-validation
-                   , tls
-                   , time
-                   , crypto-random
-                   , crypto-pubkey
-  ghc-options:       -Wall -fno-warn-orphans -fno-warn-missing-signatures -fwarn-tabs
+flag devel
+    description: Development commands
+    default:     False
 
-Benchmark bench-tls
-  hs-source-dirs:    Benchmarks Tests
-  Main-Is:           Benchmarks.hs
-  type:              exitcode-stdio-1.0
-  Build-depends:     base >= 4 && < 5
-                   , tls
-                   , x509
-                   , x509-validation
-                   , data-default-class
-                   , crypto-random
-                   , criterion
-                   , cprng-aes
-                   , mtl
-                   , bytestring
-                   , crypto-pubkey >= 0.2
-                   , time
-                   , QuickCheck >= 2
+library
+    exposed-modules:
+        Network.TLS
+        Network.TLS.Cipher
+        Network.TLS.Compression
+        Network.TLS.Internal
+        Network.TLS.Extra
+        Network.TLS.Extra.Cipher
+        Network.TLS.Extra.CipherCBC
+        Network.TLS.Extra.FFDHE
+        Network.TLS.QUIC
 
-source-repository head
-  type: git
-  location: git://github.com/vincenthz/hs-tls
-  subdir: core
+    other-modules:
+        Network.TLS.Struct
+        Network.TLS.Struct13
+        Network.TLS.Core
+        Network.TLS.Context
+        Network.TLS.Context.Internal
+        Network.TLS.Credentials
+        Network.TLS.Backend
+        Network.TLS.Crypto
+        Network.TLS.Crypto.DH
+        Network.TLS.Crypto.IES
+        Network.TLS.Crypto.Types
+        Network.TLS.ErrT
+        Network.TLS.Error
+        Network.TLS.Extension
+        Network.TLS.Handshake
+        Network.TLS.Handshake.Certificate
+        Network.TLS.Handshake.Client
+        Network.TLS.Handshake.Client.ClientHello
+        Network.TLS.Handshake.Client.Common
+        Network.TLS.Handshake.Client.ServerHello
+        Network.TLS.Handshake.Client.TLS12
+        Network.TLS.Handshake.Client.TLS13
+        Network.TLS.Handshake.Common
+        Network.TLS.Handshake.Common13
+        Network.TLS.Handshake.Control
+        Network.TLS.Handshake.Key
+        Network.TLS.Handshake.Random
+        Network.TLS.Handshake.Server
+        Network.TLS.Handshake.Server.ClientHello
+        Network.TLS.Handshake.Server.ClientHello12
+        Network.TLS.Handshake.Server.ClientHello13
+        Network.TLS.Handshake.Server.Common
+        Network.TLS.Handshake.Server.ServerHello12
+        Network.TLS.Handshake.Server.ServerHello13
+        Network.TLS.Handshake.Server.TLS12
+        Network.TLS.Handshake.Server.TLS13
+        Network.TLS.Handshake.Signature
+        Network.TLS.Handshake.State
+        Network.TLS.Handshake.State13
+        Network.TLS.Handshake.TranscriptHash
+        Network.TLS.HashAndSignature
+        Network.TLS.Hooks
+        Network.TLS.IO
+        Network.TLS.IO.Decode
+        Network.TLS.IO.Encode
+        Network.TLS.Imports
+        Network.TLS.KeySchedule
+        Network.TLS.MAC
+        Network.TLS.Measurement
+        Network.TLS.Packet
+        Network.TLS.Packet13
+        Network.TLS.Parameters
+        Network.TLS.PostHandshake
+        Network.TLS.RNG
+        Network.TLS.Record
+        Network.TLS.Record.Decrypt
+        Network.TLS.Record.Encrypt
+        Network.TLS.Record.Layer
+        Network.TLS.Record.Recv
+        Network.TLS.Record.Send
+        Network.TLS.Record.State
+        Network.TLS.Record.Types
+        Network.TLS.Session
+        Network.TLS.State
+        Network.TLS.Types
+        Network.TLS.Types.Cipher
+        Network.TLS.Types.Secret
+        Network.TLS.Types.Session
+        Network.TLS.Types.Version
+        Network.TLS.Util
+        Network.TLS.Util.ASN1
+        Network.TLS.Util.Serialization
+        Network.TLS.Wire
+        Network.TLS.X509
+
+    default-language:   Haskell2010
+    default-extensions: Strict StrictData
+    ghc-options:        -Wall
+    build-depends:
+        base >=4.9 && <5,
+        base16-bytestring,
+        bytestring >=0.10 && <0.13,
+        cereal >=0.5.3 && <0.6,
+        crypton >=1.1.2 && <1.2,
+        crypton-asn1-encoding >= 0.10.0 && < 0.11,
+        crypton-asn1-types >= 0.4.1 && < 0.5,
+        crypton-x509 >=1.9 && <1.10,
+        crypton-x509-store >=1.9 && <1.10,
+        crypton-x509-validation >=1.9 && <1.10,
+        data-default,
+        ech-config,
+        hpke >=0.1.0 && <0.2,
+        mlkem >= 0.2.0 && <0.3,
+        mtl >=2.2 && <2.4,
+        network >=3.1,
+        ram >=0.22.0 && <0.23,
+        random >=1.2 && <1.4,
+        serialise >=0.2 && <0.3,
+        transformers >=0.5 && <0.7,
+        unix-time >=0.4.11 && <0.6,
+        zlib >=0.7 && <0.8
+
+executable tls-server
+    main-is:            tls-server.hs
+    hs-source-dirs:     util
+    other-modules:
+        Common
+        Server
+        Imports
+
+    default-language:   Haskell2010
+    default-extensions: Strict StrictData
+    ghc-options:        -Wall -threaded -rtsopts
+    build-depends:
+        base >=4.9 && <5,
+        base16-bytestring,
+        bytestring,
+        containers,
+        crypton,
+        crypton-x509-store,
+        crypton-x509-system,
+        ech-config,
+        network,
+        network-run,
+        tls
+
+    if flag(devel)
+
+    else
+        buildable: False
+
+executable tls-client
+    main-is:            tls-client.hs
+    hs-source-dirs:     util
+    other-modules:
+        Client
+        Common
+        Imports
+
+    default-language:   Haskell2010
+    default-extensions: Strict StrictData
+    ghc-options:        -Wall -threaded -rtsopts
+    build-depends:
+        base >=4.9 && <5,
+        base16-bytestring,
+        bytestring,
+        crypton,
+        crypton-x509-store,
+        crypton-x509-system,
+        ech-config,
+        network,
+        network-run >=0.5,
+        tls
+
+    if flag(devel)
+
+    else
+        buildable: False
+
+test-suite spec
+    type:               exitcode-stdio-1.0
+    main-is:            Spec.hs
+    build-tool-depends: hspec-discover:hspec-discover
+    hs-source-dirs:     test
+    other-modules:
+        API
+        Arbitrary
+        Certificate
+        CiphersSpec
+        ECHSpec
+        EncodeSpec
+        HandshakeSpec
+        PipeChan
+        PubKey
+        Run
+        Session
+        ThreadSpec
+
+    default-language:   Haskell2010
+    default-extensions: Strict StrictData
+    ghc-options:        -Wall -threaded -rtsopts
+    build-depends:
+        base >=4.9 && <5,
+        QuickCheck,
+        async,
+        base64-bytestring,
+        bytestring,
+        crypton,
+        crypton-asn1-types,
+        crypton-x509,
+        crypton-x509-validation,
+        ech-config,
+        hspec,
+        ram,
+        serialise,
+        time-hourglass,
+        tls
+
+benchmark tls-bench
+    type:             exitcode-stdio-1.0
+    main-is:          Benchmarks.hs
+    hs-source-dirs:   Benchmarks test
+    other-modules:
+        API
+        Arbitrary
+        Certificate
+        CiphersSpec
+        ECHSpec
+        EncodeSpec
+        HandshakeSpec
+        PipeChan
+        PubKey
+        Run
+        Session
+        ThreadSpec
+
+    default-language: Haskell2010
+    ghc-options:      -Wall
+    build-depends:
+        base >=4.9 && <5,
+        QuickCheck,
+        async,
+        base64-bytestring,
+        bytestring,
+        containers,
+        crypton,
+        crypton-asn1-types,
+        crypton-x509,
+        crypton-x509-store,
+        crypton-x509-validation,
+        data-default,
+        ech-config,
+        hspec,
+        network,
+        network-run,
+        serialise,
+        tasty-bench,
+        time-hourglass,
+        tls
diff --git a/util/Client.hs b/util/Client.hs
new file mode 100644
--- /dev/null
+++ b/util/Client.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Client (
+    Aux (..),
+    Cli,
+    clientHTTP11,
+    clientDNS,
+) where
+
+import qualified Data.ByteString.Base16 as BS16
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy.Char8 as CL8
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NE
+import Network.Socket
+import Network.TLS
+
+import Imports
+
+data Aux = Aux
+    { auxAuthority :: HostName
+    , auxPort :: ServiceName
+    , auxDebugPrint :: String -> IO ()
+    , auxShow :: ByteString -> IO ()
+    , auxReadResumptionData :: IO [(SessionID, SessionData)]
+    }
+
+type Cli = Aux -> NonEmpty ByteString -> Context -> IO ()
+
+clientHTTP11 :: Cli
+clientHTTP11 aux@Aux{..} paths ctx = do
+    sendData ctx $
+        CL8.fromStrict $
+            "GET "
+                <> NE.head paths
+                <> " HTTP/1.1\r\n"
+                <> "Host: "
+                <> C8.pack auxAuthority
+                <> "\r\n"
+                <> "Connection: close\r\n"
+                <> "\r\n"
+    consume ctx aux
+
+clientDNS :: Cli
+clientDNS Aux{..} _paths ctx = do
+    sendData
+        ctx
+        "\x00\x2c\xdc\xe3\x01\x00\x00\x01\x00\x00\x00\x00\x00\x01\x03\x77\x77\x77\x07\x65\x78\x61\x6d\x70\x6c\x65\x03\x63\x6f\x6d\x00\x00\x01\x00\x01\x00\x00\x29\x04\xd0\x00\x00\x00\x00\x00\x00"
+    bs <- recvData ctx
+    auxShow $ "Reply: " <> BS16.encode bs
+    auxShow "\n"
+
+consume :: Context -> Aux -> IO ()
+consume ctx Aux{..} = loop
+  where
+    loop = do
+        bs <- recvData ctx
+        if bs == ""
+            then auxShow "\n"
+            else auxShow bs >> loop
diff --git a/util/Common.hs b/util/Common.hs
new file mode 100644
--- /dev/null
+++ b/util/Common.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE CPP #-}
+-- Disable this warning so we can still test deprecated functionality.
+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
+
+module Common (
+    printDHParams,
+    printGroups,
+    readNumber,
+    readDHParams,
+    readGroups,
+    getCertificateStore,
+    getLogger,
+    namedGroups,
+    getInfo,
+    printHandshakeInfo,
+    showBytesHex,
+) where
+
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Char8 as C8
+import Data.Char (isDigit)
+import Data.X509.CertificateStore
+import Network.TLS hiding (HostName)
+import Network.TLS.Extra.FFDHE
+import System.Exit
+import System.X509
+
+import Imports
+
+namedDHParams :: [(String, DHParams)]
+namedDHParams =
+    [ ("ffdhe2048", ffdhe2048)
+    , ("ffdhe3072", ffdhe3072)
+    , ("ffdhe4096", ffdhe4096)
+    , ("ffdhe6144", ffdhe6144)
+    , ("ffdhe8192", ffdhe8192)
+    ]
+
+{- FOURMOLU_DISABLE -}
+namedGroups :: [(String, Group)]
+namedGroups =
+    [ ("ffdhe2048",      FFDHE2048)
+    , ("ffdhe3072",      FFDHE3072)
+    , ("ffdhe4096",      FFDHE4096)
+    , ("ffdhe6144",      FFDHE6144)
+    , ("ffdhe8192",      FFDHE8192)
+    , ("p256",           P256)
+    , ("p384",           P384)
+    , ("p521",           P521)
+    , ("x25519",         X25519)
+    , ("x448",           X448)
+    , ("mlkem512",       MLKEM512)
+    , ("mlkem768",       MLKEM768)
+    , ("mlkem1024",      MLKEM1024)
+    , ("x25519mlkem768", X25519MLKEM768)
+    , ("p256mlkem768",   P256MLKEM768)
+    , ("p384mlkem1024",  P384MLKEM1024)
+    ]
+{- FOURMOLU_ENABLE -}
+
+readNumber :: (Num a, Read a) => String -> Maybe a
+readNumber s
+    | all isDigit s = Just $ read s
+    | otherwise = Nothing
+
+readDHParams :: String -> IO (Maybe DHParams)
+readDHParams s =
+    case lookup s namedDHParams of
+        Nothing -> (Just . read) `fmap` readFile s
+        mparams -> return mparams
+
+readGroups :: String -> [Group]
+readGroups s = fromMaybe [] $ traverse (`lookup` namedGroups) (split ',' s)
+
+printDHParams :: IO ()
+printDHParams = do
+    putStrLn "DH Parameters"
+    putStrLn "====================================="
+    forM_ namedDHParams $ \(name, _) -> putStrLn name
+    putStrLn "(or /path/to/dhparams)"
+
+printGroups :: IO ()
+printGroups = do
+    putStrLn "Groups"
+    putStrLn "====================================="
+    forM_ namedGroups $ \(name, _) -> putStrLn name
+
+split :: Char -> String -> [String]
+split _ "" = []
+split c s = case break (c ==) s of
+    ("", _ : rs) -> split c rs
+    (s', "") -> [s']
+    (s', _ : rs) -> s' : split c rs
+
+getCertificateStore :: [FilePath] -> IO CertificateStore
+getCertificateStore [] = getSystemCertificateStore
+getCertificateStore paths = foldM readPathAppend mempty paths
+  where
+    readPathAppend acc path = do
+        mstore <- readCertificateStore path
+        case mstore of
+            Nothing -> error ("invalid certificate store: " ++ path)
+            Just st -> return $! mappend st acc
+
+getLogger :: Maybe FilePath -> (String -> IO ())
+getLogger Nothing = \_ -> return ()
+getLogger (Just file) = \msg -> appendFile file (msg ++ "\n")
+
+getInfo :: Context -> IO Information
+getInfo ctx = do
+    minfo <- contextGetInformation ctx
+    case minfo of
+        Nothing -> do
+            putStrLn "Error: information cannot be obtained"
+            exitFailure
+        Just info -> return info
+
+printHandshakeInfo :: Information -> IO ()
+printHandshakeInfo i = do
+    putStrLn $ "Version: " ++ show (infoVersion i)
+    putStrLn $ "Cipher: " ++ show (infoCipher i)
+    putStrLn $ "Compression: " ++ show (infoCompression i)
+    putStrLn $ "Groups: " ++ maybe "(none)" show (infoSupportedGroup i)
+    when (infoVersion i < TLS13) $ do
+        putStrLn $ "Extended master secret: " ++ show (infoExtendedMainSecret i)
+        putStrLn $ "Resumption: " ++ show (infoTLS12Resumption i)
+    when (infoVersion i == TLS13) $ do
+        putStrLn $ "Handshake mode: " ++ show (fromJust (infoTLS13HandshakeMode i))
+        putStrLn $ "Early data accepted: " ++ show (infoIsEarlyDataAccepted i)
+        putStrLn $ "Encrypted client hello accepted: " ++ show (infoIsECHAccepted i)
+
+showBytesHex :: ByteString -> String
+showBytesHex bs = C8.unpack $ B16.encode bs
diff --git a/util/Imports.hs b/util/Imports.hs
new file mode 100644
--- /dev/null
+++ b/util/Imports.hs
@@ -0,0 +1,17 @@
+module Imports (
+    ByteString,
+    module Control.Applicative,
+    module Control.Monad,
+    module Data.List,
+    module Data.Maybe,
+    module Data.Monoid,
+    module Data.Word,
+) where
+
+import Control.Applicative
+import Control.Monad
+import Data.ByteString (ByteString)
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Word
diff --git a/util/Server.hs b/util/Server.hs
new file mode 100644
--- /dev/null
+++ b/util/Server.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Server where
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy.Char8 as CL8
+import Data.IORef
+import Network.TLS
+import Prelude hiding (getLine)
+
+import Imports
+
+-- "<>" creates *chunks* of lazy ByteString, resulting
+-- many TLS fragments.
+-- To prevent this, strict ByteString is created first and
+-- converted into lazy one.
+html :: CL8.ByteString
+html =
+    CL8.fromStrict $
+        "HTTP/1.1 200 OK\r\n"
+            <> "Context-Type: text/html\r\n"
+            <> "Content-Length: "
+            <> C8.pack (show (BS.length body))
+            <> "\r\n"
+            <> "\r\n"
+            <> body
+  where
+    body = "<html><<body>Hello world!</body></html>"
+
+server :: Context -> Bool -> IO ()
+server ctx showRequest = do
+    bs <- recvData ctx
+    case C8.uncons bs of
+        Nothing -> return ()
+        Just ('A', _) -> do
+            sendData ctx $ CL8.fromStrict bs
+            echo ctx
+        Just _ -> handleHTML ctx showRequest bs
+
+echo :: Context -> IO ()
+echo ctx = loop
+  where
+    loop = do
+        bs <- recvData ctx
+        when (bs /= "") $ do
+            sendData ctx $ CL8.fromStrict bs
+            loop
+
+handleHTML :: Context -> Bool -> ByteString -> IO ()
+handleHTML ctx showRequest ini = do
+    getLine <- newSource ctx ini
+    process getLine
+  where
+    process getLine = do
+        bs <- getLine
+        when ("GET /keyupdate" `BS.isPrefixOf` bs) $ do
+            r <- updateKey ctx TwoWay
+            putStrLn $ "Updating key..." ++ if r then "OK" else "NG"
+        when ("GET /secret" `BS.isPrefixOf` bs) $ do
+            r <- requestCertificate ctx
+            putStrLn $ "Post handshake authentication..." ++ if r then "OK" else "NG"
+        when (bs /= "") $ do
+            when showRequest $ do
+                BS.putStr bs
+                BS.putStr "\n"
+            consume getLine
+            sendData ctx html
+    consume getLine = do
+        bs <- getLine
+        when (bs /= "") $ do
+            when showRequest $ do
+                BS.putStr bs
+                BS.putStr "\n"
+            consume getLine
+
+newSource :: Context -> ByteString -> IO (IO ByteString)
+newSource ctx ini = do
+    ref <- newIORef ini
+    return $ getline ref
+  where
+    getline :: IORef ByteString -> IO ByteString
+    getline ref = do
+        bs0 <- readIORef ref
+        case BS.breakSubstring "\n" bs0 of
+            (_, "") -> do
+                bs1 <- recvData ctx
+                writeIORef ref (bs0 <> bs1)
+                getline ref
+            (bs1, bs2) -> do
+                writeIORef ref $ BS.drop 1 bs2
+                return $ BS.dropWhileEnd (== 0x0d) bs1
diff --git a/util/tls-client.hs b/util/tls-client.hs
new file mode 100644
--- /dev/null
+++ b/util/tls-client.hs
@@ -0,0 +1,465 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main where
+
+import Control.Concurrent
+import qualified Control.Exception as E
+import qualified Data.ByteString.Base16 as BS16
+import qualified Data.ByteString.Char8 as C8
+import Data.IORef
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NE
+import Data.X509.CertificateStore
+import Network.Run.TCP
+import Network.Socket
+import Network.TLS hiding (is0RTTPossible)
+import Network.TLS.ECH.Config
+import Network.TLS.Internal (makeCipherShowPretty)
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import System.X509
+
+import Client
+import Common
+import Imports
+
+data Options = Options
+    { optDebugLog :: Bool
+    , optShow :: Bool
+    , optKeyLogFile :: Maybe FilePath
+    , optGroups :: [Group]
+    , optValidate :: Bool
+    , optVerNego :: Bool
+    , optResumption :: Bool
+    , opt0RTT :: Bool
+    , optRetry :: Bool
+    , optVersions :: [Version]
+    , optALPN :: String
+    , optCertFile :: Maybe FilePath
+    , optKeyFile :: Maybe FilePath
+    , optECHConfigFile :: Maybe FilePath
+    , optTraceKey :: Bool
+    , optIPv4Only :: Bool
+    , optIPv6Only :: Bool
+    , optTrustedAnchor :: Maybe FilePath
+    }
+    deriving (Show)
+
+defaultOptions :: Options
+defaultOptions =
+    Options
+        { optDebugLog = False
+        , optShow = False
+        , optKeyLogFile = Nothing
+        , optGroups = supportedGroups defaultSupported
+        , optValidate = False
+        , optVerNego = False
+        , optResumption = False
+        , opt0RTT = False
+        , optRetry = False
+        , optVersions = supportedVersions defaultSupported
+        , optALPN = "http/1.1"
+        , optCertFile = Nothing
+        , optKeyFile = Nothing
+        , optECHConfigFile = Nothing
+        , optTraceKey = False
+        , optIPv4Only = False
+        , optIPv6Only = False
+        , optTrustedAnchor = Nothing
+        }
+
+usage :: String
+usage = "Usage: tls-client [OPTION] addr port [path]"
+
+options :: [OptDescr (Options -> Options)]
+options =
+    [ Option
+        ['d']
+        ["debug"]
+        (NoArg (\o -> o{optDebugLog = True}))
+        "print debug info"
+    , Option
+        ['v']
+        ["show-content"]
+        (NoArg (\o -> o{optShow = True}))
+        "print downloaded content"
+    , Option
+        ['l']
+        ["key-log-file"]
+        (ReqArg (\file o -> o{optKeyLogFile = Just file}) "<file>")
+        "a file to store negotiated secrets"
+    , Option
+        ['g']
+        ["groups"]
+        (ReqArg (\gs o -> o{optGroups = readGroups gs}) "<groups>")
+        "specify groups"
+    , Option
+        ['e']
+        ["validate"]
+        (NoArg (\o -> o{optValidate = True}))
+        "validate server's certificate"
+    , Option
+        ['R']
+        ["resumption"]
+        (NoArg (\o -> o{optResumption = True}))
+        "try session resumption"
+    , Option
+        ['Z']
+        ["0rtt"]
+        (NoArg (\o -> o{opt0RTT = True}))
+        "try sending early data"
+    , Option
+        ['S']
+        ["hello-retry"]
+        (NoArg (\o -> o{optRetry = True}))
+        "try client hello retry"
+    , Option
+        ['2']
+        ["tls12"]
+        (NoArg (\o -> o{optVersions = [TLS12]}))
+        "use TLS 1.2"
+    , Option
+        ['3']
+        ["tls13"]
+        (NoArg (\o -> o{optVersions = [TLS13]}))
+        "use TLS 1.3"
+    , Option
+        ['a']
+        ["alpn"]
+        (ReqArg (\a o -> o{optALPN = a}) "<alpn>")
+        "set ALPN"
+    , Option
+        ['c']
+        ["cert"]
+        (ReqArg (\fl o -> o{optCertFile = Just fl}) "<file>")
+        "certificate file"
+    , Option
+        ['k']
+        ["key"]
+        (ReqArg (\fl o -> o{optKeyFile = Just fl}) "<file>")
+        "key file"
+    , Option
+        []
+        ["ech-config"]
+        (ReqArg (\fl o -> o{optECHConfigFile = Just fl}) "<file>")
+        "ECH config file"
+    , Option
+        []
+        ["trace-key"]
+        (NoArg (\o -> o{optTraceKey = True}))
+        "Trace transcript hash"
+    , Option
+        ['4']
+        []
+        (NoArg (\o -> o{optIPv4Only = True, optIPv6Only = False}))
+        "IPv4 only"
+    , Option
+        ['6']
+        []
+        (NoArg (\o -> o{optIPv6Only = True, optIPv4Only = False}))
+        "IPv6 only"
+    , Option
+        ['t']
+        ["trusted-anchor"]
+        (ReqArg (\fl o -> o{optTrustedAnchor = Just fl}) "<file>")
+        "trusted anchor file"
+    ]
+
+showUsageAndExit :: String -> IO a
+showUsageAndExit msg = do
+    putStrLn msg
+    putStrLn $ usageInfo usage options
+    putStrLn $ "  <groups> = " ++ intercalate "," (map fst namedGroups)
+    exitFailure
+
+clientOpts :: [String] -> IO (Options, [String])
+clientOpts argv =
+    case getOpt Permute options argv of
+        (o, n, []) -> return (foldl (flip id) defaultOptions o, n)
+        (_, _, errs) -> showUsageAndExit $ concat errs
+
+main :: IO ()
+main = do
+    args <- getArgs
+    (opts@Options{..}, ips) <- clientOpts args
+    (host, port, paths) <- case ips of
+        [] -> showUsageAndExit usage
+        _ : [] -> showUsageAndExit usage
+        h : p : [] -> return (h, p, ["/"])
+        h : p : ps -> return (h, p, C8.pack <$> NE.fromList ps)
+    when (null optGroups) $ do
+        putStrLn "Error: unsupported groups"
+        exitFailure
+    let onCertReq = \_ -> case optCertFile of
+            Just certFile -> case optKeyFile of
+                Just keyFile -> do
+                    Right (!cc, !priv) <- credentialLoadX509 certFile keyFile
+                    return $ Just (cc, priv)
+                _ -> return Nothing
+            _ -> return Nothing
+    ref <- newIORef []
+    let debug
+            | optDebugLog = putStrLn
+            | otherwise = \_ -> return ()
+        traceKey
+            | optTraceKey = putStrLn
+            | otherwise = \_ -> return ()
+        showContent
+            | optShow = C8.putStr
+            | otherwise = \_ -> return ()
+        aux =
+            Aux
+                { auxAuthority = host
+                , auxPort = port
+                , auxDebugPrint = debug
+                , auxShow = showContent
+                , auxReadResumptionData = readIORef ref
+                }
+    mstore <- case optTrustedAnchor of
+        Nothing ->
+            if optValidate then Just <$> getSystemCertificateStore else return Nothing
+        Just file -> do
+            mstore' <- readCertificateStore file
+            when (isNothing mstore') $ showUsageAndExit "cannot set trusted anchor"
+            return mstore'
+    echConfList <- case optECHConfigFile of
+        Nothing -> return []
+        Just ecnff ->
+            loadECHConfigList ecnff `E.catch` \(E.SomeException _) -> do
+                putStrLn $ ecnff ++ " is broken"
+                exitFailure
+    let cparams =
+            getClientParams
+                opts
+                host
+                port
+                (smIORef ref)
+                mstore
+                onCertReq
+                echConfList
+                debug
+                traceKey
+        client
+            | optALPN == "dot" = clientDNS
+            | otherwise = clientHTTP11
+    makeCipherShowPretty
+    runClient opts client cparams aux paths
+
+runClient
+    :: Options -> Cli -> ClientParams -> Aux -> NonEmpty ByteString -> IO ()
+runClient opts@Options{..} client cparams aux@Aux{..} paths = do
+    auxDebugPrint "------------------------"
+    (info1, msd) <- runTLS opts cparams aux $ \ctx -> do
+        i1 <- getInfo ctx
+        when optDebugLog $ printHandshakeInfo i1
+        client aux paths ctx
+        msd' <- auxReadResumptionData
+        return (i1, msd')
+    if
+        | optResumption ->
+            if isResumptionPossible msd
+                then do
+                    let cparams2 = modifyClientParams cparams msd False
+                    info2 <- runClient2 opts client cparams2 aux paths
+                    if infoVersion info1 == TLS12
+                        then do
+                            if infoTLS12Resumption info2
+                                then do
+                                    putStrLn "Result: (R) TLS resumption ... OK"
+                                    exitSuccess
+                                else do
+                                    putStrLn "Result: (R) TLS resumption ... NG"
+                                    exitFailure
+                        else do
+                            if infoTLS13HandshakeMode info2 == Just PreSharedKey
+                                then do
+                                    putStrLn "Result: (R) TLS resumption ... OK"
+                                    exitSuccess
+                                else do
+                                    putStrLn "Result: (R) TLS resumption ... NG"
+                                    exitFailure
+                else do
+                    putStrLn "Result: (R) TLS resumption ... NG"
+                    exitFailure
+        | opt0RTT ->
+            if is0RTTPossible info1 msd
+                then do
+                    let cparams2 = modifyClientParams cparams msd True
+                    info2 <- runClient2 opts client cparams2 aux paths
+                    if infoTLS13HandshakeMode info2 == Just RTT0
+                        then do
+                            putStrLn "Result: (Z) 0-RTT ... OK"
+                            exitSuccess
+                        else do
+                            putStrLn "Result: (Z) 0-RTT ... NG"
+                            exitFailure
+                else do
+                    putStrLn "Result: (Z) 0-RTT ... NG"
+                    exitFailure
+        | optRetry ->
+            if infoTLS13HandshakeMode info1 == Just HelloRetryRequest
+                then do
+                    putStrLn "Result: (S) retry ... OK"
+                    exitSuccess
+                else do
+                    putStrLn "Result: (S) retry ... NG"
+                    exitFailure
+        | otherwise -> do
+            putStrLn "Result: (H) handshake ... OK"
+            when (optALPN == "http/1.1") $
+                putStrLn "Result: (1) HTTP/1.1 transaction ... OK"
+            exitSuccess
+
+runClient2
+    :: Options
+    -> Cli
+    -> ClientParams
+    -> Aux
+    -> NonEmpty ByteString
+    -> IO Information
+runClient2 opts@Options{..} client cparams aux@Aux{..} paths = do
+    threadDelay 100000
+    auxDebugPrint "<<<< next connection >>>>"
+    auxDebugPrint "------------------------"
+    runTLS opts cparams aux $ \ctx -> do
+        if opt0RTT
+            then do
+                void $ client aux paths ctx
+                i <- getInfo ctx
+                when optDebugLog $ printHandshakeInfo i
+                return i
+            else do
+                i <- getInfo ctx
+                when optDebugLog $ printHandshakeInfo i
+                void $ client aux paths ctx
+                return i
+
+runTLS
+    :: Options
+    -> ClientParams
+    -> Aux
+    -> (Context -> IO a)
+    -> IO a
+runTLS Options{..} cparams Aux{..} action =
+    runTCPClientWithSettings settings auxAuthority auxPort $ \sock -> do
+        ctx <- contextNew sock cparams
+        when optDebugLog $
+            contextHookSetLogging
+                ctx
+                defaultLogging
+                    { loggingPacketSent = putStrLn . (">> " ++)
+                    , loggingPacketRecv = putStrLn . ("<< " ++)
+                    --                    , loggingIOSent = \bs -> putStrLn $ "}} " ++ showBytesHex bs
+                    --                    , loggingIORecv = \hd bs -> putStrLn $ "{{ " ++ show hd ++ " " ++ showBytesHex bs
+                    }
+        handshake ctx
+        r <- action ctx
+        bye ctx
+        return r
+  where
+    select addrs
+        | optIPv4Only = case NE.filter (\ai -> addrFamily ai == AF_INET) addrs of
+            [] -> error "IPv4 address is not available"
+            ai : _ -> ai
+        | optIPv6Only = case NE.filter (\ai -> addrFamily ai == AF_INET6) addrs of
+            [] -> error "IPv6 address is not available"
+            ai : _ -> ai
+        | otherwise = NE.head addrs
+    settings =
+        defaultSettings
+            { settingsSelectAddrInfo = select
+            }
+
+modifyClientParams
+    :: ClientParams -> [(SessionID, SessionData)] -> Bool -> ClientParams
+modifyClientParams cparams ts early =
+    cparams
+        { clientWantSessionResumeList = ts
+        , clientUseEarlyData = early
+        }
+
+getClientParams
+    :: Options
+    -> HostName
+    -> ServiceName
+    -> SessionManager
+    -> Maybe CertificateStore
+    -> OnCertificateRequest
+    -> ECHConfigList
+    -> (String -> IO ())
+    -> (String -> IO ())
+    -> ClientParams
+getClientParams Options{..} serverName port sm mstore onCertReq echConfList printError traceKey =
+    (defaultParamsClient serverName (C8.pack port))
+        { clientSupported = supported
+        , clientUseServerNameIndication = True
+        , clientShared = shared
+        , clientHooks = hooks
+        , clientDebug = debug
+        , clientUseECH = not (null echConfList)
+        }
+  where
+    groups
+        | optRetry = FFDHE8192 : optGroups
+        | otherwise = optGroups
+    shared =
+        defaultShared
+            { sharedSessionManager = sm
+            , sharedCAStore = fromMaybe mempty mstore
+            , sharedValidationCache = validateCache
+            , sharedLimit =
+                defaultLimit
+                    { limitRecordSize = Just 8192
+                    }
+            , sharedECHConfigList = echConfList
+            }
+    supported =
+        defaultSupported
+            { supportedVersions = optVersions
+            , supportedGroups = groups
+            }
+    hooks =
+        defaultClientHooks
+            { onSuggestALPN = return $ Just [C8.pack optALPN]
+            , onCertificateRequest = onCertReq
+            }
+    validateCache
+        | isJust mstore = sharedValidationCache defaultShared
+        | otherwise =
+            ValidationCache
+                (\_ _ _ -> return ValidationCachePass)
+                (\_ _ _ -> return ())
+    debug =
+        defaultDebugParams
+            { debugKeyLogger = getLogger optKeyLogFile
+            , debugError = printError
+            , debugTraceKey = traceKey
+            }
+
+smIORef :: IORef [(SessionID, SessionData)] -> SessionManager
+smIORef ref =
+    noSessionManager
+        { sessionEstablish = \sid sdata ->
+            modifyIORef' ref (\xs -> (sid, sdata) : xs)
+                >> printTicket sid sdata
+                >> return Nothing
+        }
+
+printTicket :: SessionID -> SessionData -> IO ()
+printTicket sid sdata = do
+    C8.putStr $ "Ticket: " <> C8.take 16 (BS16.encode sid) <> "..., "
+    putStrLn $ "0-RTT: " <> if sessionMaxEarlyDataSize sdata > 0 then "OK" else "NG"
+
+isResumptionPossible :: [(SessionID, SessionData)] -> Bool
+isResumptionPossible = not . null
+
+is0RTTPossible :: Information -> [(SessionID, SessionData)] -> Bool
+is0RTTPossible _ [] = False
+is0RTTPossible info xs =
+    infoVersion info == TLS13
+        && any (\(_, sd) -> sessionMaxEarlyDataSize sd > 0) xs
diff --git a/util/tls-server.hs b/util/tls-server.hs
new file mode 100644
--- /dev/null
+++ b/util/tls-server.hs
@@ -0,0 +1,270 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main where
+
+import Data.IORef
+import qualified Data.Map.Strict as M
+import Data.X509.CertificateStore
+import Network.Run.TCP
+import Network.TLS
+import Network.TLS.ECH.Config
+import Network.TLS.Internal
+import System.Console.GetOpt
+import System.Environment (getArgs)
+import System.Exit
+import System.IO
+import System.X509
+
+import Common
+import Imports
+import Server
+
+data Options = Options
+    { optDebugLog :: Bool
+    , optClientAuth :: Bool
+    , optShow :: Bool
+    , optKeyLogFile :: Maybe FilePath
+    , optTrustedAnchor :: Maybe FilePath
+    , optGroups :: [Group]
+    , optCertFile :: FilePath
+    , optKeyFile :: FilePath
+    , optECHConfigFile :: Maybe FilePath
+    , optECHKeyFile :: Maybe FilePath
+    , optTraceKey :: Bool
+    }
+    deriving (Show)
+
+defaultOptions :: Options
+defaultOptions =
+    Options
+        { optDebugLog = False
+        , optClientAuth = False
+        , optShow = False
+        , optKeyLogFile = Nothing
+        , optTrustedAnchor = Nothing
+        , -- excluding FFDHE8192 for retry
+          optGroups = FFDHE8192 `delete` supportedGroups defaultSupported
+        , optCertFile = "servercert.pem"
+        , optKeyFile = "serverkey.pem"
+        , optECHConfigFile = Nothing
+        , optECHKeyFile = Nothing
+        , optTraceKey = False
+        }
+
+options :: [OptDescr (Options -> Options)]
+options =
+    [ Option
+        ['a']
+        ["client-auth"]
+        (NoArg (\o -> o{optClientAuth = True}))
+        "require client authentication"
+    , Option
+        ['d']
+        ["debug"]
+        (NoArg (\o -> o{optDebugLog = True}))
+        "print debug info"
+    , Option
+        ['v']
+        ["show-content"]
+        (NoArg (\o -> o{optShow = True}))
+        "print downloaded content"
+    , Option
+        ['l']
+        ["key-log-file"]
+        (ReqArg (\file o -> o{optKeyLogFile = Just file}) "<file>")
+        "a file to store negotiated secrets"
+    , Option
+        ['g']
+        ["groups"]
+        (ReqArg (\gs o -> o{optGroups = readGroups gs}) "<groups>")
+        "groups for key exchange"
+    , Option
+        ['c']
+        ["cert"]
+        (ReqArg (\fl o -> o{optCertFile = fl}) "<file>")
+        "certificate file"
+    , Option
+        ['k']
+        ["key"]
+        (ReqArg (\fl o -> o{optKeyFile = fl}) "<file>")
+        "key file"
+    , Option
+        ['t']
+        ["trusted-anchor"]
+        (ReqArg (\fl o -> o{optTrustedAnchor = Just fl}) "<file>")
+        "trusted anchor file"
+    , Option
+        []
+        ["ech-config"]
+        (ReqArg (\fl o -> o{optECHConfigFile = Just fl}) "<file>")
+        "ECH config file"
+    , Option
+        []
+        ["ech-key"]
+        (ReqArg (\fl o -> o{optECHKeyFile = Just fl}) "<file>")
+        "ECH key file"
+    , Option
+        []
+        ["trace-key"]
+        (NoArg (\o -> o{optTraceKey = True}))
+        "Trace transcript hash"
+    ]
+
+usage :: String
+usage = "Usage: tls-server [OPTION] addr port"
+
+showUsageAndExit :: String -> IO a
+showUsageAndExit msg = do
+    putStrLn msg
+    putStrLn $ usageInfo usage options
+    exitFailure
+
+serverOpts :: [String] -> IO (Options, [String])
+serverOpts argv =
+    case getOpt Permute options argv of
+        (o, n, []) -> return (foldl (flip id) defaultOptions o, n)
+        (_, _, errs) -> showUsageAndExit $ concat errs
+
+main :: IO ()
+main = do
+    hSetBuffering stdout NoBuffering
+    args <- getArgs
+    (Options{..}, ips) <- serverOpts args
+    (host, port) <- case ips of
+        [h, p] -> return (h, p)
+        _ -> showUsageAndExit "cannot recognize <addr> and <port>\n"
+    when (null optGroups) $ do
+        putStrLn "Error: unsupported groups"
+        exitFailure
+    smgr <- newSessionManager
+    Right cred@(!_cc, !_priv) <- credentialLoadX509 optCertFile optKeyFile
+    mstore <- do
+        mstore' <- case optTrustedAnchor of
+            Nothing -> Just <$> getSystemCertificateStore
+            Just file -> readCertificateStore file
+        when (isNothing mstore') $ showUsageAndExit "cannot set trusted anchor"
+        return mstore'
+    ech <- case optECHKeyFile of
+        Nothing -> case optECHConfigFile of
+            Nothing -> return ([], [])
+            Just _ -> showUsageAndExit "must specify ECH key file, too"
+        Just ekeyf -> case optECHConfigFile of
+            Nothing -> showUsageAndExit "must specify ECH config file, too"
+            Just ecnff -> do
+                ekey <- loadECHSecretKeys [ekeyf]
+                ecnf <- loadECHConfigList ecnff
+                return (ekey, ecnf)
+    let keyLog = getLogger optKeyLogFile
+        printError
+            | optDebugLog = putStrLn
+            | otherwise = \_ -> return ()
+        traceKey
+            | optTraceKey = putStrLn
+            | otherwise = \_ -> return ()
+        creds = Credentials [cred]
+    makeCipherShowPretty
+    runTCPServer (Just host) port $ \sock -> do
+        let sparams =
+                getServerParams
+                    creds
+                    optGroups
+                    smgr
+                    keyLog
+                    optClientAuth
+                    mstore
+                    ech
+                    printError
+                    traceKey
+        ctx <- contextNew sock sparams
+        when optDebugLog $
+            contextHookSetLogging
+                ctx
+                defaultLogging
+                    { loggingPacketSent = putStrLn . ("<< " ++)
+                    , loggingPacketRecv = putStrLn . (">> " ++)
+                    --                    , loggingIOSent = \bs -> putStrLn $ "{{ " ++ showBytesHex bs
+                    --                    , loggingIORecv = \hd bs -> putStrLn $ "}} " ++ show hd ++ " " ++ showBytesHex bs
+                    }
+        when (optDebugLog || optShow) $ putStrLn "------------------------"
+        handshake ctx
+        when optDebugLog $
+            getInfo ctx >>= printHandshakeInfo
+        server ctx optShow
+        bye ctx
+
+getServerParams
+    :: Credentials
+    -> [Group]
+    -> SessionManager
+    -> (String -> IO ())
+    -> Bool
+    -> Maybe CertificateStore
+    -> ([(Word8, ByteString)], ECHConfigList)
+    -> (String -> IO ())
+    -> (String -> IO ())
+    -> ServerParams
+getServerParams creds groups sm keyLog clientAuth mstore (ekey, ecnf) printError traceKey =
+    defaultParamsServer
+        { serverSupported = supported
+        , serverShared = shared
+        , serverHooks = hooks
+        , serverDebug = debug
+        , serverEarlyDataSize = 2048
+        , serverWantClientCert = clientAuth
+        , serverECHKey = ekey
+        }
+  where
+    shared =
+        defaultShared
+            { sharedCredentials = creds
+            , sharedSessionManager = sm
+            , sharedCAStore = case mstore of
+                Just store -> store
+                Nothing -> sharedCAStore defaultShared
+            , sharedECHConfigList = ecnf
+            , sharedLimit =
+                defaultLimit
+                    { limitRecordSize = Just 16384
+                    }
+            }
+    supported =
+        defaultSupported
+            { supportedGroups = groups
+            }
+    hooks =
+        defaultServerHooks
+            { onALPNClientSuggest = Just chooseALPN
+            , onClientCertificate = case mstore of
+                Nothing -> onClientCertificate defaultServerHooks
+                Just _ ->
+                    validateClientCertificate (sharedCAStore shared) (sharedValidationCache shared)
+            }
+    debug =
+        defaultDebugParams
+            { debugKeyLogger = keyLog
+            , debugError = printError
+            , debugTraceKey = traceKey
+            }
+
+chooseALPN :: [ByteString] -> IO ByteString
+chooseALPN protos
+    | "http/1.1" `elem` protos = return "http/1.1"
+    | otherwise = return ""
+
+newSessionManager :: IO SessionManager
+newSessionManager = do
+    ref <- newIORef M.empty
+    return $
+        noSessionManager
+            { sessionResume = \key -> do
+                M.lookup key <$> readIORef ref
+            , sessionResumeOnlyOnce = \key -> do
+                M.lookup key <$> readIORef ref
+            , sessionEstablish = \key val -> do
+                atomicModifyIORef' ref $ \m -> (M.insert key val m, Nothing)
+            , sessionInvalidate = \key -> do
+                atomicModifyIORef' ref $ \m -> (M.delete key m, ())
+            , sessionUseTicket = False
+            }