1-- | 2-- Module : Network.TLS.Record.Disengage 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Disengage a record from the Record layer. 9-- The record is decrypted, checked for integrity and then decompressed. 10-- 11-- Starting with TLS v1.3, only the "null" compression method is negotiated in 12-- the handshake, so the decompression step will be a no-op. Decryption and 13-- integrity verification are performed using an AEAD cipher only. 14-- 15{-# LANGUAGE FlexibleContexts #-} 16 17module Network.TLS.Record.Disengage 18 ( disengageRecord 19 ) where 20 21import Control.Monad.State.Strict 22 23import Crypto.Cipher.Types (AuthTag(..)) 24import Network.TLS.Struct 25import Network.TLS.ErrT 26import Network.TLS.Cap 27import Network.TLS.Record.State 28import Network.TLS.Record.Types 29import Network.TLS.Cipher 30import Network.TLS.Crypto 31import Network.TLS.Compression 32import Network.TLS.Util 33import Network.TLS.Wire 34import Network.TLS.Packet 35import Network.TLS.Imports 36import qualified Data.ByteString as B 37import qualified Data.ByteArray as B (convert, xor) 38 39disengageRecord :: Record Ciphertext -> RecordM (Record Plaintext) 40disengageRecord = decryptRecord >=> uncompressRecord 41 42uncompressRecord :: Record Compressed -> RecordM (Record Plaintext) 43uncompressRecord record = onRecordFragment record $ fragmentUncompress $ \bytes -> 44 withCompression $ compressionInflate bytes 45 46decryptRecord :: Record Ciphertext -> RecordM (Record Compressed) 47decryptRecord record@(Record ct ver fragment) = do 48 st <- get 49 case stCipher st of 50 Nothing -> noDecryption 51 _ -> do 52 recOpts <- getRecordOptions 53 let mver = recordVersion recOpts 54 if recordTLS13 recOpts 55 then decryptData13 mver (fragmentGetBytes fragment) st 56 else onRecordFragment record $ fragmentUncipher $ \e -> 57 decryptData mver record e st 58 where 59 noDecryption = onRecordFragment record $ fragmentUncipher return 60 decryptData13 mver e st 61 | ct == ProtocolType_AppData = do 62 inner <- decryptData mver record e st 63 case unInnerPlaintext inner of 64 Left message -> throwError $ Error_Protocol (message, True, UnexpectedMessage) 65 Right (ct', d) -> return $ Record ct' ver (fragmentCompressed d) 66 | otherwise = noDecryption 67 68unInnerPlaintext :: ByteString -> Either String (ProtocolType, ByteString) 69unInnerPlaintext inner = 70 case B.unsnoc dc of 71 Nothing -> Left $ unknownContentType13 (0 :: Word8) 72 Just (bytes,c) -> 73 case valToType c of 74 Nothing -> Left $ unknownContentType13 c 75 Just ct 76 | B.null bytes && ct `elem` nonEmptyContentTypes -> 77 Left ("empty " ++ show ct ++ " record disallowed") 78 | otherwise -> Right (ct, bytes) 79 where 80 (dc,_pad) = B.spanEnd (== 0) inner 81 nonEmptyContentTypes = [ ProtocolType_Handshake, ProtocolType_Alert ] 82 unknownContentType13 c = "unknown TLS 1.3 content type: " ++ show c 83 84getCipherData :: Record a -> CipherData -> RecordM ByteString 85getCipherData (Record pt ver _) cdata = do 86 -- check if the MAC is valid. 87 macValid <- case cipherDataMAC cdata of 88 Nothing -> return True 89 Just digest -> do 90 let new_hdr = Header pt ver (fromIntegral $ B.length $ cipherDataContent cdata) 91 expected_digest <- makeDigest new_hdr $ cipherDataContent cdata 92 return (expected_digest `bytesEq` digest) 93 94 -- check if the padding is filled with the correct pattern if it exists 95 -- (before TLS10 this checks instead that the padding length is minimal) 96 paddingValid <- case cipherDataPadding cdata of 97 Nothing -> return True 98 Just (pad, blksz) -> do 99 cver <- getRecordVersion 100 let b = B.length pad - 1 101 return $ if cver < TLS10 102 then b < blksz 103 else B.replicate (B.length pad) (fromIntegral b) `bytesEq` pad 104 105 unless (macValid &&! paddingValid) $ 106 throwError $ Error_Protocol ("bad record mac", True, BadRecordMac) 107 108 return $ cipherDataContent cdata 109 110decryptData :: Version -> Record Ciphertext -> ByteString -> RecordState -> RecordM ByteString 111decryptData ver record econtent tst = decryptOf (cstKey cst) 112 where cipher = fromJust "cipher" $ stCipher tst 113 bulk = cipherBulk cipher 114 cst = stCryptState tst 115 macSize = hashDigestSize $ cipherHash cipher 116 blockSize = bulkBlockSize bulk 117 econtentLen = B.length econtent 118 119 explicitIV = hasExplicitBlockIV ver 120 121 sanityCheckError = throwError (Error_Packet "encrypted content too small for encryption parameters") 122 123 decryptOf :: BulkState -> RecordM ByteString 124 decryptOf (BulkStateBlock decryptF) = do 125 let minContent = (if explicitIV then bulkIVSize bulk else 0) + max (macSize + 1) blockSize 126 127 -- check if we have enough bytes to cover the minimum for this cipher 128 when ((econtentLen `mod` blockSize) /= 0 || econtentLen < minContent) sanityCheckError 129 130 {- update IV -} 131 (iv, econtent') <- if explicitIV 132 then get2o econtent (bulkIVSize bulk, econtentLen - bulkIVSize bulk) 133 else return (cstIV cst, econtent) 134 let (content', iv') = decryptF iv econtent' 135 modify $ \txs -> txs { stCryptState = cst { cstIV = iv' } } 136 137 let paddinglength = fromIntegral (B.last content') + 1 138 let contentlen = B.length content' - paddinglength - macSize 139 (content, mac, padding) <- get3i content' (contentlen, macSize, paddinglength) 140 getCipherData record CipherData 141 { cipherDataContent = content 142 , cipherDataMAC = Just mac 143 , cipherDataPadding = Just (padding, blockSize) 144 } 145 146 decryptOf (BulkStateStream (BulkStream decryptF)) = do 147 -- check if we have enough bytes to cover the minimum for this cipher 148 when (econtentLen < macSize) sanityCheckError 149 150 let (content', bulkStream') = decryptF econtent 151 {- update Ctx -} 152 let contentlen = B.length content' - macSize 153 (content, mac) <- get2i content' (contentlen, macSize) 154 modify $ \txs -> txs { stCryptState = cst { cstKey = BulkStateStream bulkStream' } } 155 getCipherData record CipherData 156 { cipherDataContent = content 157 , cipherDataMAC = Just mac 158 , cipherDataPadding = Nothing 159 } 160 161 decryptOf (BulkStateAEAD decryptF) = do 162 let authTagLen = bulkAuthTagLen bulk 163 nonceExpLen = bulkExplicitIV bulk 164 cipherLen = econtentLen - authTagLen - nonceExpLen 165 166 -- check if we have enough bytes to cover the minimum for this cipher 167 when (econtentLen < (authTagLen + nonceExpLen)) sanityCheckError 168 169 (enonce, econtent', authTag) <- get3o econtent (nonceExpLen, cipherLen, authTagLen) 170 let encodedSeq = encodeWord64 $ msSequence $ stMacState tst 171 iv = cstIV (stCryptState tst) 172 ivlen = B.length iv 173 Header typ v _ = recordToHeader record 174 hdrLen = if ver >= TLS13 then econtentLen else cipherLen 175 hdr = Header typ v $ fromIntegral hdrLen 176 ad | ver >= TLS13 = encodeHeader hdr 177 | otherwise = B.concat [ encodedSeq, encodeHeader hdr ] 178 sqnc = B.replicate (ivlen - 8) 0 `B.append` encodedSeq 179 nonce | nonceExpLen == 0 = B.xor iv sqnc 180 | otherwise = iv `B.append` enonce 181 (content, authTag2) = decryptF nonce econtent' ad 182 183 when (AuthTag (B.convert authTag) /= authTag2) $ 184 throwError $ Error_Protocol ("bad record mac", True, BadRecordMac) 185 186 modify incrRecordState 187 return content 188 189 decryptOf BulkStateUninitialized = 190 throwError $ Error_Protocol ("decrypt state uninitialized", True, InternalError) 191 192 -- handling of outer format can report errors with Error_Packet 193 get3o s ls = maybe (throwError $ Error_Packet "record bad format") return $ partition3 s ls 194 get2o s (d1,d2) = get3o s (d1,d2,0) >>= \(r1,r2,_) -> return (r1,r2) 195 196 -- all format errors related to decrypted content are reported 197 -- externally as integrity failures, i.e. BadRecordMac 198 get3i s ls = maybe (throwError $ Error_Protocol ("record bad format", True, BadRecordMac)) return $ partition3 s ls 199 get2i s (d1,d2) = get3i s (d1,d2,0) >>= \(r1,r2,_) -> return (r1,r2) 200