module Network.TLS.Record.Disengage
( disengageRecord
) where
import Control.Monad.State
import Crypto.Cipher.Types (AuthTag(..))
import Network.TLS.Struct
import Network.TLS.ErrT
import Network.TLS.Cap
import Network.TLS.Record.State
import Network.TLS.Record.Types
import Network.TLS.Cipher
import Network.TLS.Crypto
import Network.TLS.Compression
import Network.TLS.Util
import Network.TLS.Wire
import Network.TLS.Packet
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteArray as B (convert)
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
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)
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 (cstKey cst)
where cipher = fromJust "cipher" $ stCipher tst
bulk = cipherBulk cipher
cst = stCryptState tst
macSize = hashDigestSize $ cipherHash cipher
blockSize = bulkBlockSize bulk
econtentLen = B.length econtent
explicitIV = hasExplicitBlockIV ver
sanityCheckError = throwError (Error_Packet "encrypted content too small for encryption parameters")
decryptOf :: BulkState -> RecordM Bytes
decryptOf (BulkStateBlock decryptF) = do
let minContent = (if explicitIV then bulkIVSize bulk else 0) + max (macSize + 1) blockSize
when ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent) $ sanityCheckError
(iv, econtent') <- if explicitIV
then get2 econtent (bulkIVSize bulk, econtentLen bulkIVSize bulk)
else return (cstIV cst, econtent)
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) <- get3 content' (contentlen, macSize, paddinglength)
getCipherData record $ CipherData
{ cipherDataContent = content
, cipherDataMAC = Just mac
, cipherDataPadding = Just padding
}
decryptOf (BulkStateStream (BulkStream decryptF)) = do
when (econtentLen < macSize) $ sanityCheckError
let (content', bulkStream') = decryptF econtent
let contentlen = B.length content' macSize
(content, mac) <- get2 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
when (econtentLen < (authTagLen + nonceExpLen)) $ sanityCheckError
(enonce, econtent', authTag) <- get3 econtent (nonceExpLen, cipherLen, authTagLen)
let encodedSeq = encodeWord64 $ msSequence $ stMacState tst
Header typ v _ = recordToHeader record
hdr = Header typ v $ fromIntegral cipherLen
ad = B.concat [ encodedSeq, encodeHeader hdr ]
nonce = cstIV (stCryptState tst) `B.append` enonce
(content, authTag2) = decryptF nonce econtent' ad
when (AuthTag (B.convert authTag) /= authTag2) $
throwError $ Error_Protocol ("bad record mac", True, BadRecordMac)
modify incrRecordState
return content
decryptOf BulkStateUninitialized =
throwError $ Error_Protocol ("decrypt state uninitialized", True, InternalError)
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)