separate tx/rx compression and pending compression.

Fix issue with compression being turn on for tx and rx at the same time,
and also at too early at the hello message instead of change cipher.

core/Network/TLS/Handshake/Server.hs

@@ -94,9 +94,9 @@ handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession cip
     when (null commonCompressions) $
             throwCore $ Error_Protocol ("no compression in common with the client", True, HandshakeFailure)
     usingState_ ctx $ runRecordStateSt $ modify (\st -> st
-            { stVersion       = ver
+            { stVersion            = ver
-            , stPendingCipher = Just usedCipher
+            , stPendingCipher      = Just usedCipher
-            , stCompression   = usedCompression
+            , stPendingCompression = usedCompression
             })
 
     resumeSessionData <- case clientSession of

core/Network/TLS/Record/Disengage.hs

@@ -30,7 +30,7 @@ disengageRecord = decryptRecord >=> uncompressRecord
 
 uncompressRecord :: Record Compressed -> RecordM (Record Plaintext)
 uncompressRecord record = onRecordFragment record $ fragmentUncompress $ \bytes ->
-    withCompression $ compressionInflate bytes
+    withRxCompression $ compressionInflate bytes
 
 decryptRecord :: Record Ciphertext -> RecordM (Record Compressed)
 decryptRecord record = onRecordFragment record $ fragmentUncipher $ \e -> do

core/Network/TLS/Record/Engage.hs

@@ -29,7 +29,7 @@ engageRecord = compressRecord >=> encryptRecord
 compressRecord :: Record Plaintext -> RecordM (Record Compressed)
 compressRecord record =
     onRecordFragment record $ fragmentCompress $ \bytes -> do
-        withCompression $ compressionDeflate bytes
+        withTxCompression $ compressionDeflate bytes
 
 {-
  - when Tx Encrypted is set, we pass the data through encryptContent, otherwise

core/Network/TLS/Record/State.hs

@@ -14,7 +14,8 @@ module Network.TLS.Record.State
     , RecordState(..)
     , newRecordState
     , RecordM(..)
-    , withCompression
+    , withTxCompression
+    , withRxCompression
     , genTLSRandom
     , makeDigest
     ) where
@@ -61,7 +62,9 @@ data RecordState = RecordState
     , stActiveTxCipher      :: Maybe Cipher
     , stActiveRxCipher      :: Maybe Cipher
     , stPendingCipher       :: Maybe Cipher
-    , stCompression         :: Compression
+    , stTxCompression       :: Compression
+    , stRxCompression       :: Compression
+    , stPendingCompression  :: Compression
     , stRandomGen           :: StateRNG
     } deriving (Show)
 
@@ -95,15 +98,24 @@ newRecordState rng clientContext = RecordState
     , stActiveTxCipher      = Nothing
     , stActiveRxCipher      = Nothing
     , stPendingCipher       = Nothing
-    , stCompression         = nullCompression
+    , stTxCompression       = nullCompression
+    , stRxCompression       = nullCompression
+    , stPendingCompression  = nullCompression
     , stRandomGen           = StateRNG rng
     }
 
-withCompression :: (Compression -> (Compression, a)) -> RecordM a
+withTxCompression :: (Compression -> (Compression, a)) -> RecordM a
-withCompression f = do
+withTxCompression f = do
     st <- get
-    let (nc, a) = f (stCompression st)
+    let (nc, a) = f (stTxCompression st)
-    put $ st { stCompression = nc }
+    put $ st { stTxCompression = nc }
+    return a
+
+withRxCompression :: (Compression -> (Compression, a)) -> RecordM a
+withRxCompression f = do
+    st <- get
+    let (nc, a) = f (stRxCompression st)
+    put $ st { stRxCompression = nc }
     return a
 
 genTLSRandom :: Int -> RecordM Bytes

core/Network/TLS/State.hs

@@ -217,14 +217,16 @@ certVerifyHandshakeMaterial :: Handshake -> Bool
 certVerifyHandshakeMaterial = certVerifyHandshakeTypeMaterial . typeOfHandshake
 
 switchTxEncryption, switchRxEncryption :: MonadState RecordState m => m ()
-switchTxEncryption = modify (\st -> st { stTxEncrypted = True
+switchTxEncryption = modify (\st -> st { stTxEncrypted        = True
-                                       , stActiveTxMacState = stPendingTxMacState st
+                                       , stActiveTxMacState   = stPendingTxMacState st
                                        , stActiveTxCryptState = stPendingTxCryptState st
-                                       , stActiveTxCipher = stPendingCipher st })
+                                       , stActiveTxCipher     = stPendingCipher st
-switchRxEncryption = modify (\st -> st { stRxEncrypted = True
+                                       , stTxCompression      = stPendingCompression st })
-                                       , stActiveRxMacState = stPendingRxMacState st
+switchRxEncryption = modify (\st -> st { stRxEncrypted        = True
+                                       , stActiveRxMacState   = stPendingRxMacState st
                                        , stActiveRxCryptState = stPendingRxCryptState st
-                                       , stActiveRxCipher = stPendingCipher st })
+                                       , stActiveRxCipher     = stPendingCipher st
+                                       , stRxCompression      = stPendingCompression st })
 
 setServerRandom :: MonadState TLSState m => ServerRandom -> m ()
 setServerRandom ran = updateHandshake "srand" (\hst -> hst { hstServerRandom = Just ran })