Adding states and parameters for TLS 1.3

core/Network/TLS/Context.hs

@@ -131,7 +131,7 @@ contextNew backend params = liftIO $ do
 
     stvar <- newMVar st
     eof   <- newIORef False
-    established <- 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.
@@ -141,6 +141,7 @@ contextNew backend params = liftIO $ do
     tx    <- newMVar newRecordState
     rx    <- newMVar newRecordState
     hs    <- newMVar Nothing
+    as    <- newMVar []
     lockWrite <- newMVar ()
     lockRead  <- newMVar ()
     lockState <- newMVar ()
@@ -164,6 +165,7 @@ contextNew backend params = liftIO $ do
             , ctxLockWrite        = lockWrite
             , ctxLockRead         = lockRead
             , ctxLockState        = lockState
+            , ctxPendingActions   = as
             }
 
 -- | create a new context on an handle.

core/Network/TLS/Context/Internal.hs

@@ -19,6 +19,7 @@ module Network.TLS.Context.Internal
     -- * Context object and accessor
     , Context(..)
     , Hooks(..)
+    , Established(..)
     , ctxEOF
     , ctxHasSSLv2ClientHello
     , ctxDisableSSLv2ClientHello
@@ -83,6 +84,7 @@ data Information = Information
     , infoMasterSecret :: Maybe ByteString
     , infoClientRandom :: Maybe ClientRandom
     , infoServerRandom :: Maybe ServerRandom
+    , infoIsEarlyDataAccepted :: Bool
     } deriving (Show,Eq)
 
 -- | A TLS Context keep tls specific state, parameters and backend information.
@@ -93,7 +95,7 @@ data Context = Context
     , 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.
+    , ctxEstablished_     :: IORef Established -- ^ 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
@@ -108,8 +110,15 @@ data Context = Context
     , 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.
+    , ctxPendingActions   :: MVar [ByteString -> IO ()]
     }
 
+data Established = NotEstablished
+                 | EarlyDataAllowed
+                 | EarlyDataNotAllowed
+                 | Established
+                 deriving (Eq, Show)
+
 updateMeasure :: Context -> (Measurement -> Measurement) -> IO ()
 updateMeasure ctx f = do
     x <- readIORef (ctxMeasurement ctx)
@@ -135,8 +144,11 @@ contextGetInformation ctx = do
                                        hstServerRandom st)
                            Nothing -> (Nothing, Nothing, Nothing)
     (cipher,comp) <- failOnEitherError $ runRxState ctx $ gets $ \st -> (stCipher st, stCompression st)
+    let accepted = case hstate of
+            Just st -> hstTLS13RTT0Status st == RTT0Accepted
+            Nothing -> False
     case (ver, cipher) of
-        (Just v, Just c) -> return $ Just $ Information v c comp ms cr sr
+        (Just v, Just c) -> return $ Just $ Information v c comp ms cr sr accepted
         _                -> return Nothing
 
 contextSend :: Context -> ByteString -> IO ()
@@ -157,7 +169,7 @@ 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
@@ -166,7 +178,7 @@ ctxWithHooks ctx f = readIORef (ctxHooks ctx) >>= f
 contextModifyHooks :: Context -> (Hooks -> Hooks) -> IO ()
 contextModifyHooks ctx f = modifyIORef (ctxHooks ctx) f
 
-setEstablished :: Context -> Bool -> IO ()
+setEstablished :: Context -> Established -> IO ()
 setEstablished ctx v = writeIORef (ctxEstablished_ ctx) v
 
 withLog :: Context -> (Logging -> IO ()) -> IO ()

core/Network/TLS/Handshake.hs

@@ -42,7 +42,7 @@ handshakeWith ctx hs =
 handleException :: Context -> IO () -> IO ()
 handleException ctx f = catchException f $ \exception -> do
     let tlserror = fromMaybe (Error_Misc $ show exception) $ fromException exception
-    setEstablished ctx False
+    setEstablished ctx NotEstablished
     sendPacket ctx (errorToAlert tlserror) `catch` ignoreIOErr
     handshakeFailed tlserror
   where

core/Network/TLS/Handshake/Common.hs

@@ -14,6 +14,7 @@ module Network.TLS.Handshake.Common
     , recvPacketHandshake
     , onRecvStateHandshake
     , extensionLookup
+    , getSessionData
     ) where
 
 import Control.Concurrent.MVar
@@ -24,7 +25,7 @@ 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.State
 import Network.TLS.Handshake.Process
 import Network.TLS.Handshake.State
 import Network.TLS.Record.State
@@ -73,7 +74,7 @@ handshakeTerminate ctx = do
                     }
     updateMeasure ctx resetBytesCounters
     -- mark the secure connection up and running.
-    setEstablished ctx True
+    setEstablished ctx Established
     return ()
 
 sendChangeCipherAndFinish :: Context
@@ -126,6 +127,7 @@ getSessionData ctx = do
     sni <- usingState_ ctx getClientSNI
     mms <- usingHState ctx (gets hstMasterSecret)
     tx  <- liftIO $ readMVar (ctxTxState ctx)
+    alpn <- usingState_ ctx getNegotiatedProtocol
     case mms of
         Nothing -> return Nothing
         Just ms -> return $ Just SessionData
@@ -134,6 +136,10 @@ getSessionData ctx = do
                         , sessionCompression = compressionID $ stCompression tx
                         , sessionClientSNI   = sni
                         , sessionSecret      = ms
+                        , sessionGroup       = Nothing
+                        , sessionTicketInfo  = Nothing
+                        , sessionALPN        = alpn
+                        , sessionMaxEarlyDataSize = 0
                         }
 
 extensionLookup :: ExtensionID -> [ExtensionRaw] -> Maybe ByteString

core/Network/TLS/Handshake/Server.hs

@@ -82,7 +82,7 @@ handshakeServerWith sparams ctx clientHello@(ClientHello clientVersion _ clientS
     unless (supportedClientInitiatedRenegotiation (ctxSupported ctx)) $ do
         established <- ctxEstablished ctx
         eof <- ctxEOF ctx
-        when (established && not eof) $
+        when (established == Established && not eof) $
             throwCore $ Error_Protocol ("renegotiation is not allowed", False, NoRenegotiation)
     -- check if policy allow this new handshake to happens
     handshakeAuthorized <- withMeasure ctx (onNewHandshake $ serverHooks sparams)

core/Network/TLS/Handshake/Signature.hs

@@ -15,6 +15,9 @@ module Network.TLS.Handshake.Signature
     , digitallySignDHParamsVerify
     , digitallySignECDHParamsVerify
     , signatureCompatible
+    , signatureParams
+    , fromPubKey
+    , fromPrivKey
     ) where
 
 import Network.TLS.Crypto
@@ -30,6 +33,16 @@ import Network.TLS.Util
 
 import Control.Monad.State.Strict
 
+fromPubKey :: PubKey -> Maybe DigitalSignatureAlg
+fromPubKey (PubKeyRSA _) = Just RSA
+fromPubKey (PubKeyDSA _) = Just DSS
+fromPubKey (PubKeyEC  _) = Just ECDSA
+fromPubKey _             = Nothing
+
+fromPrivKey :: PrivKey -> Maybe DigitalSignatureAlg
+fromPrivKey (PrivKeyRSA _) = Just RSA
+fromPrivKey (PrivKeyDSA _) = Just DSS
+
 signatureCompatible :: DigitalSignatureAlg -> HashAndSignatureAlgorithm -> Bool
 signatureCompatible RSA   (_, SignatureRSA)              = True
 signatureCompatible RSA   (_, SignatureRSApssRSAeSHA256) = True

core/Network/TLS/Handshake/State.hs

@@ -10,6 +10,8 @@
 --
 module Network.TLS.Handshake.State
     ( HandshakeState(..)
+    , RTT0Status(..)
+    , TLS13Secret(..)
     , ClientCertRequestData
     , HandshakeM
     , newEmptyHandshake
@@ -40,17 +42,27 @@ module Network.TLS.Handshake.State
     , addHandshakeMessage
     , updateHandshakeDigest
     , getHandshakeMessages
+    , getHandshakeMessagesRev
     , getHandshakeDigest
     -- * master secret
     , setMasterSecret
     , setMasterSecretFromPre
     -- * misc accessor
     , getPendingCipher
     , setServerHelloParameters
+    , setTLS13Group
+    , getTLS13Group
+    , setTLS13RTT0Status
+    , getTLS13RTT0Status
+    , setTLS13HandshakeMsgs
+    , getTLS13HandshakeMsgs
+    , setTLS13Secret
+    , getTLS13Secret
     ) where
 
 import Network.TLS.Util
 import Network.TLS.Struct
+import Network.TLS.Struct13
 import Network.TLS.Record.State
 import Network.TLS.Packet
 import Network.TLS.Crypto
@@ -62,6 +74,11 @@ import Control.Monad.State.Strict
 import Data.X509 (CertificateChain)
 import Data.ByteArray (ByteArrayAccess)
 
+data TLS13Secret = NoSecret
+                 | EarlySecret ByteString
+                 | ResuptionSecret ByteString
+                 deriving (Eq, Show)
+
 data HandshakeKeyState = HandshakeKeyState
     { hksRemotePublicKey :: !(Maybe PubKey)
     , hksLocalPrivateKey :: !(Maybe PrivKey)
@@ -87,6 +104,10 @@ data HandshakeState = HandshakeState
     , hstPendingRxState      :: Maybe RecordState
     , hstPendingCipher       :: Maybe Cipher
     , hstPendingCompression  :: Compression
+    , hstTLS13Group          :: Maybe Group
+    , hstTLS13RTT0Status     :: !RTT0Status
+    , hstTLS13HandshakeMsgs  :: [Handshake13]
+    , hstTLS13Secret         :: TLS13Secret
     } deriving (Show)
 
 type ClientCertRequestData = ([CertificateType],
@@ -125,6 +146,10 @@ newEmptyHandshake ver crand = HandshakeState
     , hstPendingRxState      = Nothing
     , hstPendingCipher       = Nothing
     , hstPendingCompression  = nullCompression
+    , hstTLS13Group          = Nothing
+    , hstTLS13RTT0Status     = RTT0None
+    , hstTLS13HandshakeMsgs  = []
+    , hstTLS13Secret         = NoSecret
     }
 
 runHandshake :: HandshakeState -> HandshakeM a -> (a, HandshakeState)
@@ -144,30 +169,60 @@ getRemotePublicKey = fromJust "remote public key" <$> gets (hksRemotePublicKey .
 getLocalPrivateKey :: HandshakeM PrivKey
 getLocalPrivateKey = fromJust "local private key" <$> gets (hksLocalPrivateKey . hstKeyState)
 
+setServerDHParams :: ServerDHParams -> HandshakeM ()
+setServerDHParams shp = modify (\hst -> hst { hstServerDHParams = Just shp })
+
 getServerDHParams :: HandshakeM ServerDHParams
 getServerDHParams = fromJust "server DH params" <$> gets hstServerDHParams
 
+setServerECDHParams :: ServerECDHParams -> HandshakeM ()
+setServerECDHParams shp = modify (\hst -> hst { hstServerECDHParams = Just shp })
+
 getServerECDHParams :: HandshakeM ServerECDHParams
 getServerECDHParams = fromJust "server ECDH params" <$> gets hstServerECDHParams
 
-setServerDHParams :: ServerDHParams -> HandshakeM ()
-setServerDHParams shp = modify (\hst -> hst { hstServerDHParams = Just shp })
-
-setServerECDHParams :: ServerECDHParams -> HandshakeM ()
-setServerECDHParams shp = modify (\hst -> hst { hstServerECDHParams = Just shp })
+setDHPrivate :: DHPrivate -> HandshakeM ()
+setDHPrivate shp = modify (\hst -> hst { hstDHPrivate = Just shp })
 
 getDHPrivate :: HandshakeM DHPrivate
 getDHPrivate = fromJust "server DH private" <$> gets hstDHPrivate
 
 getGroupPrivate :: HandshakeM GroupPrivate
 getGroupPrivate = fromJust "server ECDH private" <$> gets hstGroupPrivate
 
-setDHPrivate :: DHPrivate -> HandshakeM ()
-setDHPrivate shp = modify (\hst -> hst { hstDHPrivate = Just shp })
-
 setGroupPrivate :: GroupPrivate -> HandshakeM ()
 setGroupPrivate shp = modify (\hst -> hst { hstGroupPrivate = Just shp })
 
+setTLS13Group :: Group -> HandshakeM ()
+setTLS13Group g = modify (\hst -> hst { hstTLS13Group = Just g })
+
+getTLS13Group :: HandshakeM (Maybe Group)
+getTLS13Group = gets hstTLS13Group
+
+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
+
+setTLS13HandshakeMsgs :: [Handshake13] -> HandshakeM ()
+setTLS13HandshakeMsgs hmsgs = modify (\hst -> hst { hstTLS13HandshakeMsgs = hmsgs })
+
+getTLS13HandshakeMsgs :: HandshakeM [Handshake13]
+getTLS13HandshakeMsgs = gets hstTLS13HandshakeMsgs
+
+setTLS13Secret :: TLS13Secret -> HandshakeM ()
+setTLS13Secret secret = modify (\hst -> hst { hstTLS13Secret = secret })
+
+getTLS13Secret :: HandshakeM TLS13Secret
+getTLS13Secret = gets hstTLS13Secret
+
 setCertReqSent :: Bool -> HandshakeM ()
 setCertReqSent b = modify (\hst -> hst { hstCertReqSent = b })
 
@@ -201,6 +256,9 @@ addHandshakeMessage content = modify $ \hs -> hs { hstHandshakeMessages = conten
 getHandshakeMessages :: HandshakeM [ByteString]
 getHandshakeMessages = gets (reverse . hstHandshakeMessages)
 
+getHandshakeMessagesRev :: HandshakeM [ByteString]
+getHandshakeMessagesRev = gets hstHandshakeMessages
+
 updateHandshakeDigest :: ByteString -> HandshakeM ()
 updateHandshakeDigest content = modify $ \hs -> hs
     { hstHandshakeDigest = case hstHandshakeDigest hs of

core/Network/TLS/IO.hs

@@ -30,7 +30,7 @@ import System.IO.Error (mkIOError, eofErrorType)
 checkValid :: Context -> IO ()
 checkValid ctx = do
     established <- ctxEstablished ctx
-    unless established $ throwIO ConnectionNotEstablished
+    when (established == NotEstablished) $ throwIO ConnectionNotEstablished
     eofed <- ctxEOF ctx
     when eofed $ throwIO $ mkIOError eofErrorType "data" Nothing Nothing
 

core/Network/TLS/Parameters.hs

@@ -22,6 +22,7 @@ module Network.TLS.Parameters
     , GroupUsage(..)
     , CertificateUsage(..)
     , CertificateRejectReason(..)
+    , EarlyData(..)
     ) where
 
 import Network.TLS.Extension
@@ -194,14 +195,23 @@ data Supported = Supported
       --   enough until 2030.  Both curves are fast because their
       --   backends are written in C.
     , supportedGroups              :: [Group]
+    , supportedEarlyData           :: EarlyData
     } deriving (Show,Eq)
 
+data EarlyData = NoEarlyData
+               | AcceptEarlyData Word32
+               | SendEarlyData ByteString
+               deriving (Eq, Show)
+
 defaultSupported :: Supported
 defaultSupported = Supported
     { supportedVersions       = [TLS12,TLS11,TLS10]
     , supportedCiphers        = []
     , supportedCompressions   = [nullCompression]
-    , supportedHashSignatures = [ (Struct.HashSHA512, SignatureRSA)
+    , supportedHashSignatures = [ (HashIntrinsic,     SignatureRSApssRSAeSHA256)
+                                , (HashIntrinsic,     SignatureRSApssRSAeSHA384)
+                                , (HashIntrinsic,     SignatureRSApssRSAeSHA512)
+                                , (Struct.HashSHA512, SignatureRSA)
                                 , (Struct.HashSHA512, SignatureECDSA)
                                 , (Struct.HashSHA384, SignatureRSA)
                                 , (Struct.HashSHA384, SignatureECDSA)
@@ -216,6 +226,7 @@ defaultSupported = Supported
     , supportedFallbackScsv        = True
     , supportedEmptyPacket         = True
     , supportedGroups              = [X25519,P256,P384,P521]
+    , supportedEarlyData           = AcceptEarlyData 0
     }
 
 instance Default Supported where