adding the KeyUpdateRequest argument to keyUpdate.

haskell-tls · Nov 23, 2018 · 549eb76 · 549eb76
1 parent 0c300f9
commit 549eb76
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 5 deletions.
diff --git a/core/Network/TLS.hs b/core/Network/TLS.hs
@@ -99,6 +99,7 @@ module Network.TLS
     , recvData
     , recvData'
     , updateKey
+    , KeyUpdateRequest(..)
 
     -- * Crypto Key
     , PubKey(..)

diff --git a/core/Network/TLS/Core.hs b/core/Network/TLS/Core.hs
@@ -28,6 +28,7 @@ module Network.TLS.Core
     , recvData
     , recvData'
     , updateKey
+    , KeyUpdateRequest(..)
     ) where
 
 import Network.TLS.Cipher
@@ -241,13 +242,21 @@ keyUpdate ctx getState setState = do
     let applicationTrafficSecretN1 = hkdfExpandLabel usedHash applicationTrafficSecretN "traffic upd" "" $ hashDigestSize usedHash
     setState ctx usedHash usedCipher applicationTrafficSecretN1
 
+-- | How to update keys in TLS 1.3
+data KeyUpdateRequest = OneWay -- ^ Unidirectional key update
+                      | TwoWay -- ^ Bidirectional key update (normal case)
+                      deriving (Eq, Show)
+
 -- | Updating appication traffic secrets for TLS 1.3.
 --   If this API is called for TLS 1.3, 'True' is returned.
 --   Otherwise, 'False' is returned.
-updateKey :: Context -> IO Bool
-updateKey ctx = do
+updateKey :: Context -> KeyUpdateRequest -> IO Bool
+updateKey ctx way = do
     tls13 <- tls13orLater ctx
     when tls13 $ do
-        sendPacket13 ctx $ Handshake13 [KeyUpdate13 UpdateRequested]
+        let req = case way of
+                OneWay -> UpdateNotRequested
+                TwoWay -> UpdateRequested
+        sendPacket13 ctx $ Handshake13 [KeyUpdate13 req]
         keyUpdate ctx getTxState setTxState
     return tls13
diff --git a/core/Tests/Tests.hs b/core/Tests/Tests.hs
@@ -122,7 +122,8 @@ runTLSPipeSimpleKeyUpdate params = runTLSPipeN 3 params tlsServer tlsClient
   where tlsServer ctx queue = do
             handshake ctx
             d0 <- recvDataNonNull ctx
-            _ <- updateKey ctx
+            req <- generate $ elements [OneWay, TwoWay]
+            _ <- updateKey ctx req
             d1 <- recvDataNonNull ctx
             d2 <- recvDataNonNull ctx
             writeChan queue [d0,d1,d2]
@@ -133,7 +134,8 @@ runTLSPipeSimpleKeyUpdate params = runTLSPipeN 3 params tlsServer tlsClient
             sendData ctx (L.fromChunks [d0])
             d1 <- readChan queue
             sendData ctx (L.fromChunks [d1])
-            _ <- updateKey ctx
+            req <- generate $ elements [OneWay, TwoWay]
+            _ <- updateKey ctx req
             d2 <- readChan queue
             sendData ctx (L.fromChunks [d2])
             bye ctx